module Ledger.Parser.Text
( parseJournalFile
, RawJournal(..)
, RawEntity(..)
, RawEntityInSitu(..)
, RawPosting(..)
, RawTransaction(..)
, RawAutoTxn(..)
, RawPeriodTxn(..)
) where
import Control.Applicative
import Data.ByteString (ByteString)
import Data.Maybe
import qualified Data.Text.Encoding as E
import Filesystem.Path.CurrentOS hiding (concat)
import Prelude hiding (FilePath, readFile, until)
import Text.Parser.Combinators
import Text.Parser.LookAhead
import Text.Parser.Token
import Text.Trifecta
import Text.Trifecta.Delta
infixl 4 <$!>
(<$!>) :: TokenParsing m => (a -> b) -> m a -> m b
f <$!> ma = ($!) <$> pure f <*> ma
data RawJournal = RawJournal [RawEntity]
deriving (Show, Eq)
data RawEntity = Whitespace String
| FileComment String
| Directive { directiveChar :: Maybe Char
, directiveName :: !String
, directiveArg :: Maybe String }
| RawTransactionEntity RawTransaction
| RawAutoTxnEntity RawAutoTxn
| RawPeriodTxnEntity RawPeriodTxn
| EndOfFile
deriving (Show, Eq)
data RawEntityInSitu = RawEntityInSitu { rawEntityIndex :: !Int
, rawEntityStartPos :: !Rendering
, rawEntity :: !RawEntity
, rawEntityEndPos :: !Rendering }
instance Show RawEntityInSitu where
show x = show (rawEntity x) ++ "\n"
data RawPosting = RawPosting { rawPostState :: Maybe Char
, rawPostAccount :: !String
, rawPostAmount :: Maybe String
, rawPostNote :: Maybe String }
| RawPostingNote !String
deriving (Show, Eq)
data RawTransaction = RawTransaction { rawTxnDate :: !String
, rawTxnDateAux :: Maybe String
, rawTxnState :: Maybe Char
, rawTxnCode :: Maybe String
, rawTxnDesc :: !String
, rawTxnNote :: Maybe String
, rawTxnPosts :: ![RawPosting] }
deriving (Show, Eq)
data RawAutoTxn = RawAutoTxn { rawATxnQuery :: !String
, rawATxnPosts :: ![RawPosting] }
deriving (Show, Eq)
data RawPeriodTxn = RawPeriodTxn { rawPTxnPeriod :: !String
, rawPTxnPosts :: ![RawPosting] }
deriving (Show, Eq)
txnDateParser :: TokenParsing m => m String
txnDateParser = some (digit <|> oneOf "/-." <|> letter)
<?> "transaction date"
longSep :: CharParsing m => m ()
longSep = () <$ (try (char ' ' *> char ' ') <|> tab)
noteParser :: (LookAheadParsing m, CharParsing m) => m String
noteParser = char ';' *> manyTill anyChar (try (lookAhead endOfLine))
<?> "note"
longSepOrEOL :: (LookAheadParsing m, CharParsing m) => m ()
longSepOrEOL = try (lookAhead (longSep <|> endOfLine))
longSepOrEOLIf :: (LookAheadParsing m, CharParsing m) => m p -> m ()
longSepOrEOLIf p = try (lookAhead ((() <$ longSep <* p) <|> endOfLine))
until :: CharParsing m => m () -> m String
until end = (:) <$> noneOf "\r\n" <*> manyTill anyChar end
tokenP :: TokenParsing m => m p -> m p
tokenP p = p <* skipMany spaceChars
postingParser :: (LookAheadParsing m, TokenParsing m) => m RawPosting
postingParser =
(RawPosting <$!> (some spaceChars *>
optional (tokenP (char '*' <|> char '!')))
<*> tokenP (until longSepOrEOL)
<*> optional (tokenP (until (longSepOrEOLIf (char ';'))))
<*> (optional noteParser <* endOfLine)
<?> "posting")
<|>
(RawPostingNote <$!> (concat <$!>
some ((++) <$!> (some spaceChars *> noteParser)
<*> ((:[]) <$> endOfLineChar)))
<?> "posting note")
spaceChars :: CharParsing m => m ()
spaceChars = () <$ oneOf " \t"
regularTxnParser :: (LookAheadParsing m, TokenParsing m) => m RawEntity
regularTxnParser = RawTransactionEntity <$!> go
where go = RawTransaction
<$!> txnDateParser
<*> optional (char '=' *> txnDateParser)
<*> (many spaceChars *>
optional (tokenP (char '*' <|> char '!')))
<*> optional
(tokenP (parens (many (noneOf ")\r\n"))))
<*> tokenP (until (longSepOrEOLIf (char ';')))
<*> optional noteParser
<*> (endOfLine *> some postingParser)
<?> "regular transaction"
automatedTxnParser :: (LookAheadParsing m, TokenParsing m) => m RawEntity
automatedTxnParser = RawAutoTxnEntity <$!> go
where go = RawAutoTxn
<$!> (tokenP (char '=') *>
manyTill anyChar (try (lookAhead endOfLine)))
<*> (endOfLine *> some postingParser)
<?> "automated transaction"
periodicTxnParser :: (LookAheadParsing m, TokenParsing m) => m RawEntity
periodicTxnParser = RawPeriodTxnEntity <$!> go
where go = RawPeriodTxn
<$!> (tokenP (char '~') *>
manyTill anyChar (try (lookAhead endOfLine)))
<*> (endOfLine *> some postingParser)
<?> "periodic transaction"
transactionParser :: (LookAheadParsing m, TokenParsing m) => m RawEntity
transactionParser = regularTxnParser
<|> automatedTxnParser
<|> periodicTxnParser
<?> "transaction"
directiveParser :: (LookAheadParsing m, TokenParsing m) => m RawEntity
directiveParser =
Directive <$!> optional (oneOf "@!")
<*> ((:) <$!> letter <*> tokenP (many alphaNum))
<*> (optional
((:) <$!> noneOf "\r\n"
<*> manyTill anyChar (try (lookAhead endOfLine)))
<* endOfLine)
<?> "directive"
endOfLine :: CharParsing m => m ()
endOfLine = () <$ endOfLineChar
endOfLineChar :: CharParsing m => m Char
endOfLineChar = skipOptional (char '\r') *> char '\n'
commentParser :: (LookAheadParsing m, TokenParsing m) => m RawEntity
commentParser = FileComment
<$!> (concat <$!>
some ((++) <$!> noteParser
<*> ((:[]) <$> endOfLineChar)))
<?> "comment"
whitespaceParser :: TokenParsing m => m RawEntity
whitespaceParser = Whitespace <$!> some space <?> "whitespace"
entityParser :: (LookAheadParsing m, TokenParsing m) => m RawEntity
entityParser = directiveParser
<|> commentParser
<|> whitespaceParser
<|> transactionParser
<?> "journal"
rendCaret :: DeltaParsing m => m Rendering
rendCaret = addCaret <$!> position <*> rend
journalParser :: (LookAheadParsing m, DeltaParsing m) => m [RawEntityInSitu]
journalParser =
many (RawEntityInSitu <$!> pure 0 <*> rendCaret <*> entityParser <*> rendCaret)
parseJournalFile :: FilePath -> ByteString -> Result [RawEntityInSitu]
parseJournalFile file contents =
let filepath = either id id $ toText file
start = Directed (E.encodeUtf8 filepath) 0 0 0 0
in zipWith (\e i -> e { rawEntityIndex = i})
<$> parseByteString journalParser start contents
<*> pure [1..]