1 {-|
    2 Utilities for doing I/O with ledger files.
    3 -}
    4 
    5 module Ledger.IO
    6 where
    7 import Control.Monad.Error
    8 import Data.Time.Clock
    9 import Data.Time.LocalTime (LocalTime)
   10 import Ledger.Ledger (cacheLedger)
   11 import Ledger.Parse (parseLedger)
   12 import Ledger.RawLedger (canonicaliseAmounts,filterRawLedger)
   13 import Ledger.Types (DateSpan(..),RawLedger,Ledger(..))
   14 import Ledger.Utils (getCurrentLocalTime)
   15 import System.Directory (getHomeDirectory)
   16 import System.Environment (getEnv)
   17 import System.IO
   18 import Text.ParserCombinators.Parsec
   19 import qualified Data.Map as Map (lookup)
   20 
   21 
   22 ledgerdefaultpath  = "~/.ledger"
   23 timelogdefaultpath = "~/.timelog"
   24 ledgerenvvar       = "LEDGER"
   25 timelogenvvar      = "TIMELOG"
   26 
   27 -- | A tuple of arguments specifying how to filter a raw ledger file:
   28 -- 
   29 -- - only include transactions in this date span
   30 -- 
   31 -- - only include if cleared\/uncleared\/don't care
   32 -- 
   33 -- - only include if real\/don't care
   34 -- 
   35 -- - convert all amounts to cost basis
   36 -- 
   37 -- - only include if matching these account patterns
   38 -- 
   39 -- - only include if matching these description patterns
   40 
   41 type IOArgs = (DateSpan
   42               ,Maybe Bool
   43               ,Bool
   44               ,Bool
   45               ,[String]
   46               ,[String]
   47               )
   48 
   49 noioargs = (DateSpan Nothing Nothing, Nothing, False, False, [], [])
   50 
   51 -- | Get the user's default ledger file path.
   52 myLedgerPath :: IO String
   53 myLedgerPath = 
   54     getEnv ledgerenvvar `catch` \_ -> return ledgerdefaultpath
   55   
   56 -- | Get the user's default timelog file path.
   57 myTimelogPath :: IO String
   58 myTimelogPath =
   59     getEnv timelogenvvar `catch` \_ -> return timelogdefaultpath
   60 
   61 -- | Read the user's default ledger file, or give an error.
   62 myLedger :: IO Ledger
   63 myLedger = myLedgerPath >>= readLedger
   64 
   65 -- | Read the user's default timelog file, or give an error.
   66 myTimelog :: IO Ledger
   67 myTimelog = myTimelogPath >>= readLedger
   68 
   69 -- | Read a ledger from this file, with no filtering, or give an error.
   70 readLedger :: FilePath -> IO Ledger
   71 readLedger f = tildeExpand f >>= readLedgerWithIOArgs noioargs
   72 
   73 -- | Read a ledger from this file, filtering according to the io args,
   74 -- | or give an error.
   75 readLedgerWithIOArgs :: IOArgs -> FilePath -> IO Ledger
   76 readLedgerWithIOArgs ioargs f = do
   77   t <- getCurrentLocalTime
   78   s <- readFile f 
   79   rl <- rawLedgerFromString s
   80   return $ filterAndCacheLedger ioargs s rl
   81 
   82 -- | Read a RawLedger from the given string, using the current time as
   83 -- reference time, or give a parse error.
   84 rawLedgerFromString :: String -> IO RawLedger
   85 rawLedgerFromString s = do
   86   t <- getCurrentLocalTime
   87   liftM (either error id) $ runErrorT $ parseLedger t "(string)" s
   88 
   89 -- | Convert a RawLedger to a canonicalised, cached and filtered Ledger.
   90 filterAndCacheLedger :: IOArgs -> String -> RawLedger -> Ledger
   91 filterAndCacheLedger (span,cleared,real,costbasis,apats,dpats) rawtext rl = 
   92     (cacheLedger apats 
   93     $ filterRawLedger span dpats cleared real 
   94     $ canonicaliseAmounts costbasis rl
   95     ){rawledgertext=rawtext}
   96 
   97 -- | Expand ~ in a file path (does not handle ~name).
   98 tildeExpand :: FilePath -> IO FilePath
   99 tildeExpand ('~':[])     = getHomeDirectory
  100 tildeExpand ('~':'/':xs) = getHomeDirectory >>= return . (++ ('/':xs))
  101 --handle ~name, requires -fvia-C or ghc 6.8:
  102 --import System.Posix.User
  103 -- tildeExpand ('~':xs)     =  do let (user, path) = span (/= '/') xs
  104 --                                pw <- getUserEntryForName user
  105 --                                return (homeDirectory pw ++ path)
  106 tildeExpand xs           =  return xs
  107