module Ledger.IO
where
import Control.Monad.Error
import Ledger.Ledger (cacheLedger)
import Ledger.Parse (parseLedger)
import Ledger.RawLedger (canonicaliseAmounts,filterRawLedger,rawLedgerSelectingDate)
import Ledger.Types (FilterSpec(..),WhichDate(..),DateSpan(..),RawLedger(..),Ledger(..))
import Ledger.Utils (getCurrentLocalTime)
import System.Directory (getHomeDirectory)
import System.Environment (getEnv)
import System.IO
import System.FilePath ((</>))
import System.Time (getClockTime)
ledgerenvvar = "LEDGER"
timelogenvvar = "TIMELOG"
ledgerdefaultfilename = ".ledger"
timelogdefaultfilename = ".timelog"
nullfilterspec = FilterSpec {
datespan=DateSpan Nothing Nothing
,cleared=Nothing
,real=False
,costbasis=False
,acctpats=[]
,descpats=[]
,whichdate=ActualDate
}
myLedgerPath :: IO String
myLedgerPath =
getEnv ledgerenvvar `catch`
(\_ -> do
home <- getHomeDirectory `catch` (\_ -> return "")
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 = readLedgerWithFilterSpec nullfilterspec
readLedgerWithFilterSpec :: FilterSpec -> FilePath -> IO Ledger
readLedgerWithFilterSpec fspec f = do
s <- readFile f
t <- getClockTime
rl <- rawLedgerFromString s
return $ filterAndCacheLedger fspec s rl{filepath=f, filereadtime=t}
rawLedgerFromString :: String -> IO RawLedger
rawLedgerFromString s = do
t <- getCurrentLocalTime
liftM (either error id) $ runErrorT $ parseLedger t "(string)" s
filterAndCacheLedger :: FilterSpec -> String -> RawLedger -> Ledger
filterAndCacheLedger (FilterSpec{datespan=datespan,cleared=cleared,real=real,
costbasis=costbasis,acctpats=acctpats,
descpats=descpats,whichdate=whichdate})
rawtext
rl =
(cacheLedger acctpats
$ filterRawLedger datespan descpats cleared real
$ rawLedgerSelectingDate whichdate
$ canonicaliseAmounts costbasis rl
){rawledgertext=rawtext}