module Ledger.IO
where
import Control.Monad.Error
import Ledger.Ledger (cacheLedger)
import Ledger.Parse (parseLedger)
import Ledger.RawLedger (canonicaliseAmounts,filterRawLedger)
import Ledger.Types (DateSpan(..),RawLedger,Ledger(..))
import Ledger.Utils (getCurrentLocalTime)
import System.Directory (getHomeDirectory)
import System.Environment (getEnv)
import System.IO
import System.FilePath ((</>))
ledgerenvvar = "LEDGER"
timelogenvvar = "TIMELOG"
ledgerdefaultfilename = ".ledger"
timelogdefaultfilename = ".timelog"
type IOArgs = (DateSpan
,Maybe Bool
,Bool
,Bool
,[String]
,[String]
)
noioargs = (DateSpan Nothing Nothing, Nothing, False, False, [], [])
myLedgerPath :: IO String
myLedgerPath =
getEnv ledgerenvvar `catch`
(\_ -> do
home <- getHomeDirectory
return $ home </> ledgerdefaultfilename)
myTimelogPath :: IO String
myTimelogPath =
getEnv timelogenvvar `catch`
(\_ -> do
home <- getHomeDirectory
return $ home </> timelogdefaultfilename)
myLedger :: IO Ledger
myLedger = myLedgerPath >>= readLedger
myTimelog :: IO Ledger
myTimelog = myTimelogPath >>= readLedger
readLedger :: FilePath -> IO Ledger
readLedger = readLedgerWithIOArgs noioargs
readLedgerWithIOArgs :: IOArgs -> FilePath -> IO Ledger
readLedgerWithIOArgs ioargs f = do
s <- readFile f
rl <- rawLedgerFromString s
return $ filterAndCacheLedger ioargs s rl
rawLedgerFromString :: String -> IO RawLedger
rawLedgerFromString s = do
t <- getCurrentLocalTime
liftM (either error id) $ runErrorT $ parseLedger t "(string)" s
filterAndCacheLedger :: IOArgs -> String -> RawLedger -> Ledger
filterAndCacheLedger (span,cleared,real,costbasis,apats,dpats) rawtext rl =
(cacheLedger apats
$ filterRawLedger span dpats cleared real
$ canonicaliseAmounts costbasis rl
){rawledgertext=rawtext}