mirror of
https://github.com/simonmichael/hledger.git
synced 2024-09-20 10:47:29 +03:00
811e71aba7
Like ledger, price amounts are now "unobserved", ie their precision does not affect the canonical display precisions used when displaying amounts, and transaction balancing is done based on display precision, ie amounts are considered to balance if their sum appears to be zero when using the canonical display precision.
74 lines
3.0 KiB
Haskell
74 lines
3.0 KiB
Haskell
{-|
|
|
Utilities common to hledger journal readers.
|
|
-}
|
|
|
|
module Hledger.Read.Utils
|
|
where
|
|
|
|
import Control.Monad.Error
|
|
import System.Directory (getHomeDirectory)
|
|
import System.FilePath(takeDirectory,combine)
|
|
import System.Time (getClockTime)
|
|
import Text.ParserCombinators.Parsec
|
|
|
|
import Hledger.Data.Types (Journal, JournalContext(..), Commodity, JournalUpdate)
|
|
import Hledger.Data.Utils
|
|
import Hledger.Data.Journal (nullctx, nulljournal, journalFinalise)
|
|
|
|
|
|
juSequence :: [JournalUpdate] -> JournalUpdate
|
|
juSequence us = liftM (foldr (.) id) $ sequence us
|
|
|
|
-- | Given a JournalUpdate-generating parsec parser, file path and data string,
|
|
-- parse and post-process a Journal so that it's ready to use, or give an error.
|
|
parseJournalWith :: (GenParser Char JournalContext (JournalUpdate,JournalContext)) -> FilePath -> String -> ErrorT String IO Journal
|
|
parseJournalWith p f s = do
|
|
tc <- liftIO getClockTime
|
|
tl <- liftIO getCurrentLocalTime
|
|
case runParser p nullctx f s of
|
|
Right (updates,ctx) -> do
|
|
j <- updates `ap` return nulljournal
|
|
case journalFinalise tc tl f s ctx j of
|
|
Right j' -> return j'
|
|
Left estr -> throwError estr
|
|
Left e -> throwError $ show e
|
|
|
|
setYear :: Integer -> GenParser tok JournalContext ()
|
|
setYear y = updateState (\ctx -> ctx{ctxYear=Just y})
|
|
|
|
getYear :: GenParser tok JournalContext (Maybe Integer)
|
|
getYear = liftM ctxYear getState
|
|
|
|
setCommodity :: Commodity -> GenParser tok JournalContext ()
|
|
setCommodity c = updateState (\ctx -> ctx{ctxCommodity=Just c})
|
|
|
|
getCommodity :: GenParser tok JournalContext (Maybe Commodity)
|
|
getCommodity = liftM ctxCommodity getState
|
|
|
|
pushParentAccount :: String -> GenParser tok JournalContext ()
|
|
pushParentAccount parent = updateState addParentAccount
|
|
where addParentAccount ctx0 = ctx0 { ctxAccount = normalize parent : ctxAccount ctx0 }
|
|
normalize = (++ ":")
|
|
|
|
popParentAccount :: GenParser tok JournalContext ()
|
|
popParentAccount = do ctx0 <- getState
|
|
case ctxAccount ctx0 of
|
|
[] -> unexpected "End of account block with no beginning"
|
|
(_:rest) -> setState $ ctx0 { ctxAccount = rest }
|
|
|
|
getParentAccount :: GenParser tok JournalContext String
|
|
getParentAccount = liftM (concat . reverse . ctxAccount) getState
|
|
|
|
-- | Convert a possibly relative, possibly tilde-containing file path to an absolute one.
|
|
-- using the current directory from a parsec source position. ~username is not supported.
|
|
expandPath :: (MonadIO m) => SourcePos -> FilePath -> m FilePath
|
|
expandPath pos fp = liftM mkAbsolute (expandHome fp)
|
|
where
|
|
mkAbsolute = combine (takeDirectory (sourceName pos))
|
|
expandHome inname | "~/" `isPrefixOf` inname = do homedir <- liftIO getHomeDirectory
|
|
return $ homedir ++ drop 1 inname
|
|
| otherwise = return inname
|
|
|
|
fileSuffix :: FilePath -> String
|
|
fileSuffix = reverse . takeWhile (/='.') . reverse . dropWhile (/='.')
|