module AmountParser (parseAmount) where

import           Data.Text (Text)
import qualified Hledger as HL
import           Data.Functor.Identity
import           Control.Monad.Trans.State.Strict
import           Text.Megaparsec
import           Text.Megaparsec.Char

type Parser a = HL.JournalParser Identity a

parseAmount :: HL.Journal -> Text -> Either String HL.MixedAmount
parseAmount :: Journal -> Text -> Either String MixedAmount
parseAmount Journal
journal Text
t = case Identity (Either (ParseErrorBundle Text CustomErr) MixedAmount)
-> Either (ParseErrorBundle Text CustomErr) MixedAmount
forall a. Identity a -> a
runIdentity (Identity (Either (ParseErrorBundle Text CustomErr) MixedAmount)
 -> Either (ParseErrorBundle Text CustomErr) MixedAmount)
-> Identity (Either (ParseErrorBundle Text CustomErr) MixedAmount)
-> Either (ParseErrorBundle Text CustomErr) MixedAmount
forall a b. (a -> b) -> a -> b
$ ParsecT CustomErr Text Identity MixedAmount
-> String
-> Text
-> Identity (Either (ParseErrorBundle Text CustomErr) MixedAmount)
forall (m :: * -> *) e s a.
Monad m =>
ParsecT e s m a
-> String -> s -> m (Either (ParseErrorBundle s e) a)
runParserT (StateT Journal (ParsecT CustomErr Text Identity) MixedAmount
-> Journal -> ParsecT CustomErr Text Identity MixedAmount
forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
evalStateT (StateT Journal (ParsecT CustomErr Text Identity) MixedAmount
mixed StateT Journal (ParsecT CustomErr Text Identity) MixedAmount
-> StateT Journal (ParsecT CustomErr Text Identity) (Maybe ())
-> StateT Journal (ParsecT CustomErr Text Identity) MixedAmount
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* StateT Journal (ParsecT CustomErr Text Identity) ()
-> StateT Journal (ParsecT CustomErr Text Identity) (Maybe ())
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional StateT Journal (ParsecT CustomErr Text Identity) ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
space StateT Journal (ParsecT CustomErr Text Identity) MixedAmount
-> StateT Journal (ParsecT CustomErr Text Identity) ()
-> StateT Journal (ParsecT CustomErr Text Identity) MixedAmount
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* StateT Journal (ParsecT CustomErr Text Identity) ()
forall e s (m :: * -> *). MonadParsec e s m => m ()
eof) Journal
journal) String
"" Text
t of
  Left ParseErrorBundle Text CustomErr
err -> String -> Either String MixedAmount
forall a b. a -> Either a b
Left (ParseErrorBundle Text CustomErr -> String
forall s e.
(VisualStream s, TraversableStream s, ShowErrorComponent e) =>
ParseErrorBundle s e -> String
errorBundlePretty ParseErrorBundle Text CustomErr
err)
  Right MixedAmount
res -> MixedAmount -> Either String MixedAmount
forall a b. b -> Either a b
Right MixedAmount
res

mixed :: Parser HL.MixedAmount
mixed :: StateT Journal (ParsecT CustomErr Text Identity) MixedAmount
mixed = [Amount] -> MixedAmount
HL.mixed ([Amount] -> MixedAmount)
-> StateT Journal (ParsecT CustomErr Text Identity) [Amount]
-> StateT Journal (ParsecT CustomErr Text Identity) MixedAmount
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StateT Journal (ParsecT CustomErr Text Identity) [Amount]
expr

expr :: Parser [HL.Amount]
expr :: StateT Journal (ParsecT CustomErr Text Identity) [Amount]
expr = StateT Journal (ParsecT CustomErr Text Identity) Amount
-> StateT Journal (ParsecT CustomErr Text Identity) [Amount]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
some (StateT Journal (ParsecT CustomErr Text Identity) Amount
-> StateT Journal (ParsecT CustomErr Text Identity) Amount
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (StateT Journal (ParsecT CustomErr Text Identity) Amount
 -> StateT Journal (ParsecT CustomErr Text Identity) Amount)
-> StateT Journal (ParsecT CustomErr Text Identity) Amount
-> StateT Journal (ParsecT CustomErr Text Identity) Amount
forall a b. (a -> b) -> a -> b
$ StateT Journal (ParsecT CustomErr Text Identity) Amount
-> StateT Journal (ParsecT CustomErr Text Identity) Amount
forall a. Parser a -> Parser a
lexeme StateT Journal (ParsecT CustomErr Text Identity) Amount
factor)

factor :: Parser HL.Amount
factor :: StateT Journal (ParsecT CustomErr Text Identity) Amount
factor =  (Token Text
-> StateT Journal (ParsecT CustomErr Text Identity) (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'+' StateT Journal (ParsecT CustomErr Text Identity) Char
-> StateT Journal (ParsecT CustomErr Text Identity) Amount
-> StateT Journal (ParsecT CustomErr Text Identity) Amount
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> StateT Journal (ParsecT CustomErr Text Identity) Amount
-> StateT Journal (ParsecT CustomErr Text Identity) Amount
forall a. Parser a -> Parser a
lexeme StateT Journal (ParsecT CustomErr Text Identity) Amount
forall (m :: * -> *). JournalParser m Amount
HL.amountp)
      StateT Journal (ParsecT CustomErr Text Identity) Amount
-> StateT Journal (ParsecT CustomErr Text Identity) Amount
-> StateT Journal (ParsecT CustomErr Text Identity) Amount
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Token Text
-> StateT Journal (ParsecT CustomErr Text Identity) (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'-' StateT Journal (ParsecT CustomErr Text Identity) Char
-> StateT Journal (ParsecT CustomErr Text Identity) Amount
-> StateT Journal (ParsecT CustomErr Text Identity) Amount
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Quantity -> Amount -> Amount
HL.divideAmount (-Quantity
1) (Amount -> Amount)
-> StateT Journal (ParsecT CustomErr Text Identity) Amount
-> StateT Journal (ParsecT CustomErr Text Identity) Amount
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StateT Journal (ParsecT CustomErr Text Identity) Amount
-> StateT Journal (ParsecT CustomErr Text Identity) Amount
forall a. Parser a -> Parser a
lexeme StateT Journal (ParsecT CustomErr Text Identity) Amount
forall (m :: * -> *). JournalParser m Amount
HL.amountp)
      StateT Journal (ParsecT CustomErr Text Identity) Amount
-> StateT Journal (ParsecT CustomErr Text Identity) Amount
-> StateT Journal (ParsecT CustomErr Text Identity) Amount
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> StateT Journal (ParsecT CustomErr Text Identity) Amount
forall (m :: * -> *). JournalParser m Amount
HL.amountp

lexeme :: Parser a -> Parser a
lexeme :: Parser a -> Parser a
lexeme Parser a
p = StateT Journal (ParsecT CustomErr Text Identity) ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
space StateT Journal (ParsecT CustomErr Text Identity) ()
-> Parser a -> Parser a
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Parser a
p