;pkg: drop unused 2012 ledger parsing code
and possibly github-confusing license file
This commit is contained in:
Simon Michael
parent
18bad4ff8d
commit
4535796d94
@ -1,19 +0,0 @@
|
|||||||
opyright (c) 2012 John Wiegley
|
|
||||||
|
|
||||||
Permission is hereby granted, free of charge, to any person obtaining a copy
|
|
||||||
of this software and associated documentation files (the "Software"), to deal
|
|
||||||
in the Software without restriction, including without limitation the rights
|
|
||||||
to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
|
|
||||||
copies of the Software, and to permit persons to whom the Software is
|
|
||||||
furnished to do so, subject to the following conditions:
|
|
||||||
|
|
||||||
The above copyright notice and this permission notice shall be included in
|
|
||||||
all copies or substantial portions of the Software.
|
|
||||||
|
|
||||||
THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
|
|
||||||
IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
|
|
||||||
FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
|
|
||||||
AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
|
|
||||||
LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
|
|
||||||
OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN
|
|
||||||
THE SOFTWARE.
|
|
||||||
@ -1,218 +0,0 @@
|
|||||||
{-# LANGUAGE OverloadedStrings #-}
|
|
||||||
|
|
||||||
module Ledger.Parser.Text
|
|
||||||
( parseJournalFile
|
|
||||||
, RawJournal(..)
|
|
||||||
, RawEntity(..)
|
|
||||||
, RawEntityInSitu(..)
|
|
||||||
, RawPosting(..)
|
|
||||||
, RawTransaction(..)
|
|
||||||
, RawAutoTxn(..)
|
|
||||||
, RawPeriodTxn(..)
|
|
||||||
-- , main
|
|
||||||
) 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
|
|
||||||
-- import Control.DeepSeq
|
|
||||||
-- import Criterion
|
|
||||||
-- import Criterion.Main
|
|
||||||
|
|
||||||
infixl 4 <$!>
|
|
||||||
|
|
||||||
(<$!>) :: TokenParsing m => (a -> b) -> m a -> m b
|
|
||||||
f <$!> ma = (f $!) <$> ma
|
|
||||||
|
|
||||||
newtype 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..]
|
|
||||||
|
|
||||||
-- testme :: IO (Result [RawEntityInSitu])
|
|
||||||
-- testme =
|
|
||||||
-- let file = "/Users/johnw/Documents/Finances/ledger.dat"
|
|
||||||
-- in parseJournalFile (fromText (T.pack file)) <$> B.readFile file
|
|
||||||
|
|
||||||
-- instance NFData RawEntityInSitu
|
|
||||||
-- instance NFData (Result a)
|
|
||||||
|
|
||||||
-- main = do let file = "/Users/johnw/Documents/Finances/ledger.dat"
|
|
||||||
-- bs <- B.readFile file
|
|
||||||
-- defaultMain [
|
|
||||||
-- bench "main" $ nf (parseJournalFile (fromText (T.pack file))) bs ]
|
|
||||||
|
|
||||||
-- Text.hs ends here
|
|
||||||
@ -1,4 +0,0 @@
|
|||||||
This is the parser code from John W's
|
|
||||||
https://github.com/ledger/ledger4/tree/master/ledger-parse ,
|
|
||||||
revision 8fb414c + updates for latest parsers lib.
|
|
||||||
Later, perhaps it will be a published lib and we can remove this copy.
|
|
||||||
Loading…
Reference in New Issue
Block a user