module Ledger.IO
where
import Control.Monad.Error
import Data.Time.Clock
import Data.Time.LocalTime (LocalTime)
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 Text.ParserCombinators.Parsec
import qualified Data.Map as Map (lookup)
ledgerdefaultpath = "~/.ledger"
timelogdefaultpath = "~/.timelog"
ledgerenvvar = "LEDGER"
timelogenvvar = "TIMELOG"
type IOArgs = (DateSpan
,Maybe Bool
,Bool
,Bool
,[String]
,[String]
)
noioargs = (DateSpan Nothing Nothing, Nothing, False, False, [], [])
myLedgerPath :: IO String
myLedgerPath =
getEnv ledgerenvvar `catch` \_ -> return ledgerdefaultpath
myTimelogPath :: IO String
myTimelogPath =
getEnv timelogenvvar `catch` \_ -> return timelogdefaultpath
myLedger :: IO Ledger
myLedger = myLedgerPath >>= readLedger
myTimelog :: IO Ledger
myTimelog = myTimelogPath >>= readLedger
readLedger :: FilePath -> IO Ledger
readLedger f = tildeExpand f >>= readLedgerWithIOArgs noioargs
readLedgerWithIOArgs :: IOArgs -> FilePath -> IO Ledger
readLedgerWithIOArgs ioargs f = do
t <- getCurrentLocalTime
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}
tildeExpand :: FilePath -> IO FilePath
tildeExpand ('~':[]) = getHomeDirectory
tildeExpand ('~':'/':xs) = getHomeDirectory >>= return . (++ ('/':xs))
tildeExpand xs = return xs