a little cleanup, haddock parsing context
This commit is contained in:
parent
5d78004646
commit
b218647631
@ -30,23 +30,18 @@ import Data.Time.Calendar
|
|||||||
|
|
||||||
-- utils
|
-- utils
|
||||||
|
|
||||||
parseLedgerFile :: FilePath -> ErrorT String IO RawLedger
|
-- | Some context kept during parsing.
|
||||||
parseLedgerFile "-" = liftIO (hGetContents stdin) >>= parseLedger "-"
|
data LedgerFileCtx = Ctx {
|
||||||
parseLedgerFile f = liftIO (readFile f) >>= parseLedger f
|
ctxYear :: !(Maybe Integer) -- ^ the current default year specified with Y, if any
|
||||||
|
, ctxCommod :: !(Maybe String) -- ^ I don't know
|
||||||
printParseError :: (Show a) => a -> IO ()
|
, ctxAccount :: ![String] -- ^ the current "container" account specified with !account, if any
|
||||||
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)
|
} deriving (Read, Show)
|
||||||
|
|
||||||
emptyCtx :: LedgerFileCtx
|
emptyCtx :: LedgerFileCtx
|
||||||
emptyCtx = Ctx { ctxYear = Nothing, ctxCommod = Nothing, ctxAccount = [] }
|
emptyCtx = Ctx { ctxYear = Nothing, ctxCommod = Nothing, ctxAccount = [] }
|
||||||
|
|
||||||
|
-- containing accounts "nest" hierarchically
|
||||||
|
|
||||||
pushParentAccount :: String -> GenParser tok LedgerFileCtx ()
|
pushParentAccount :: String -> GenParser tok LedgerFileCtx ()
|
||||||
pushParentAccount parent = updateState addParentAccount
|
pushParentAccount parent = updateState addParentAccount
|
||||||
where addParentAccount ctx0 = ctx0 { ctxAccount = normalize parent : ctxAccount ctx0 }
|
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 :: GenParser tok LedgerFileCtx (Maybe Integer)
|
||||||
getYear = liftM ctxYear getState
|
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 :: FilePath -> String -> ErrorT String IO RawLedger
|
||||||
parseLedger inname intxt = case runParser ledgerFile emptyCtx inname intxt of
|
parseLedger inname intxt = case runParser ledgerFile emptyCtx inname intxt of
|
||||||
Right m -> liftM rawLedgerConvertTimeLog $ m `ap` (return rawLedgerEmpty)
|
Right m -> liftM rawLedgerConvertTimeLog $ m `ap` (return rawLedgerEmpty)
|
||||||
|
|||||||
Loading…
Reference in New Issue
Block a user