simonmichael/hledger
1
1
Fork 0
mirror of https://github.com/simonmichael/hledger.git synced 2024-09-20 02:37:12 +03:00
Code Issues Projects Releases Wiki Activity

a little cleanup, haddock parsing context

Browse Source
This commit is contained in:
Simon Michael 2009-01-24 21:15:38 +00:00
parent 5d78004646
commit b218647631
1 changed files with 17 additions and 13 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

30
Ledger/Parse.hs
View File

@ -30,23 +30,18 @@ import Data.Time.Calendar
-- utils
parseLedgerFile :: FilePath -> ErrorT String IO RawLedger
parseLedgerFile "-" = liftIO (hGetContents stdin) >>= parseLedger "-"
parseLedgerFile f = liftIO (readFile f) >>= parseLedger f
printParseError :: (Show a) => a -> IO ()
printParseError e = do putStr "ledger parse error at "; print e
-- Default accounts "nest" hierarchically
data LedgerFileCtx = Ctx { ctxYear :: !(Maybe Integer)
, ctxCommod :: !(Maybe String)
, ctxAccount :: ![String]
} deriving (Read, Show)
-- | Some context kept during parsing.
data LedgerFileCtx = Ctx {
ctxYear :: !(Maybe Integer) -- ^ the current default year specified with Y, if any
, ctxCommod :: !(Maybe String) -- ^ I don't know
, ctxAccount :: ![String] -- ^ the current "container" account specified with !account, if any
} deriving (Read, Show)
emptyCtx :: LedgerFileCtx
emptyCtx = Ctx { ctxYear = Nothing, ctxCommod = Nothing, ctxAccount = [] }
-- containing accounts "nest" hierarchically
pushParentAccount :: String -> GenParser tok LedgerFileCtx ()
pushParentAccount parent = updateState addParentAccount
where addParentAccount ctx0 = ctx0 { ctxAccount = normalize parent : ctxAccount ctx0 }
@ -67,6 +62,15 @@ setYear y = updateState (\ctx -> ctx{ctxYear=Just y})
getYear :: GenParser tok LedgerFileCtx (Maybe Integer)
getYear = liftM ctxYear getState
-- let's get to it
parseLedgerFile :: FilePath -> ErrorT String IO RawLedger
parseLedgerFile "-" = liftIO (hGetContents stdin) >>= parseLedger "-"
parseLedgerFile f = liftIO (readFile f) >>= parseLedger f
printParseError :: (Show a) => a -> IO ()
printParseError e = do putStr "ledger parse error at "; print e
parseLedger :: FilePath -> String -> ErrorT String IO RawLedger
parseLedger inname intxt = case runParser ledgerFile emptyCtx inname intxt of
Right m -> liftM rawLedgerConvertTimeLog $ m `ap` (return rawLedgerEmpty)