1 {-| 
    2 
    3 Read hledger data from various data formats, and related utilities.
    4 
    5 -}
    6 
    7 module Hledger.Read (
    8        tests_Hledger_Read,
    9        readJournalFile,
   10        readJournal,
   11        journalFromPathAndString,
   12        ledgeraccountname,
   13        myJournalPath,
   14        myTimelogPath,
   15        myJournal,
   16        myTimelog,
   17        someamount,
   18        journalenvvar,
   19        journaldefaultfilename
   20 )
   21 where
   22 import Control.Monad.Error
   23 import Data.Either (partitionEithers)
   24 import Data.List
   25 import Safe (headDef)
   26 import System.Directory (doesFileExist, getHomeDirectory)
   27 import System.Environment (getEnv)
   28 import System.FilePath ((</>))
   29 import System.IO (IOMode(..), withFile, stderr)
   30 import Test.HUnit
   31 import Text.Printf
   32 
   33 import Hledger.Data.Dates (getCurrentDay)
   34 import Hledger.Data.Types (Journal(..), Reader(..))
   35 import Hledger.Data.Journal (nullctx)
   36 import Hledger.Read.JournalReader as JournalReader
   37 import Hledger.Read.TimelogReader as TimelogReader
   38 import Hledger.Utils
   39 import Prelude hiding (getContents)
   40 import Hledger.Utils.UTF8 (getContents, hGetContents)
   41 
   42 
   43 journalenvvar           = "LEDGER_FILE"
   44 journalenvvar2          = "LEDGER"
   45 timelogenvvar           = "TIMELOG"
   46 journaldefaultfilename  = ".hledger.journal"
   47 timelogdefaultfilename = ".hledger.timelog"
   48 
   49 -- Here are the available readers. The first is the default, used for unknown data formats.
   50 readers :: [Reader]
   51 readers = [
   52   JournalReader.reader
   53  ,TimelogReader.reader
   54  ]
   55 
   56 formats   = map rFormat readers
   57 
   58 readerForFormat :: String -> Maybe Reader
   59 readerForFormat s | null rs = Nothing
   60                   | otherwise = Just $ head rs
   61     where 
   62       rs = filter ((s==).rFormat) readers :: [Reader]
   63 
   64 -- | Read a Journal from this string (and file path), auto-detecting the
   65 -- data format, or give a useful error string. Tries to parse each known
   66 -- data format in turn. If none succeed, gives the error message specific
   67 -- to the intended data format, which if not specified is guessed from the
   68 -- file suffix and possibly the data.
   69 journalFromPathAndString :: Maybe String -> FilePath -> String -> IO (Either String Journal)
   70 journalFromPathAndString format fp s = do
   71   let readers' = case format of Just f -> case readerForFormat f of Just r -> [r]
   72                                                                     Nothing -> []
   73                                 Nothing -> readers
   74   (errors, journals) <- partitionEithers `fmap` mapM tryReader readers'
   75   case journals of j:_ -> return $ Right j
   76                    _   -> return $ Left $ errMsg errors
   77     where
   78       tryReader r = (runErrorT . (rParser r) fp) s
   79       errMsg [] = unknownFormatMsg
   80       errMsg es = printf "could not parse %s data in %s\n%s" (rFormat r) fp e
   81           where (r,e) = headDef (head readers, head es) $ filter detects $ zip readers es
   82                 detects (r,_) = (rDetector r) fp s
   83       unknownFormatMsg = printf "could not parse %sdata in %s" (fmt formats) fp
   84           where fmt [] = ""
   85                 fmt [f] = f ++ " "
   86                 fmt fs = intercalate ", " (init fs) ++ " or " ++ last fs ++ " "
   87 
   88 -- | Read a journal from this file, using the specified data format or
   89 -- trying all known formats, or give an error string; also create the file
   90 -- if it doesn't exist.
   91 readJournalFile :: Maybe String -> FilePath -> IO (Either String Journal)
   92 readJournalFile format "-" = getContents >>= journalFromPathAndString format "(stdin)"
   93 readJournalFile format f = do
   94   ensureJournalFile f
   95   withFile f ReadMode $ \h -> hGetContents h >>= journalFromPathAndString format f
   96 
   97 -- | Ensure there is a journal at the given file path, creating an empty one if needed.
   98 ensureJournalFile :: FilePath -> IO ()
   99 ensureJournalFile f = do
  100   exists <- doesFileExist f
  101   when (not exists) $ do
  102     hPrintf stderr "No journal file \"%s\", creating it.\n" f
  103     hPrintf stderr "Edit this file or use \"hledger add\" or \"hledger web\" to add transactions.\n"
  104     emptyJournal >>= writeFile f
  105 
  106 -- | Give the content for a new auto-created journal file.
  107 emptyJournal :: IO String
  108 emptyJournal = do
  109   d <- getCurrentDay
  110   return $ printf "; journal created %s by hledger\n\n" (show d)
  111 
  112 -- | Read a Journal from this string, using the specified data format or
  113 -- trying all known formats, or give an error string.
  114 readJournal :: Maybe String -> String -> IO (Either String Journal)
  115 readJournal format s = journalFromPathAndString format "(string)" s
  116 
  117 -- | Get the user's journal file path. Like ledger, we look first for the
  118 -- LEDGER_FILE environment variable, and if that does not exist, for the
  119 -- legacy LEDGER environment variable. If neither is set, or the value is
  120 -- blank, return the default journal file path, which is
  121 -- ".hledger.journal" in the users's home directory, or if we cannot
  122 -- determine that, in the current directory.
  123 myJournalPath :: IO String
  124 myJournalPath = do
  125   s <- envJournalPath
  126   if null s then defaultJournalPath else return s
  127     where
  128       envJournalPath = getEnv journalenvvar `catch` (\_ -> getEnv journalenvvar2 `catch` (\_ -> return ""))
  129       defaultJournalPath = do
  130                   home <- getHomeDirectory `catch` (\_ -> return "")
  131                   return $ home </> journaldefaultfilename
  132   
  133 -- | Get the user's default timelog file path.
  134 myTimelogPath :: IO String
  135 myTimelogPath =
  136     getEnv timelogenvvar `catch`
  137                (\_ -> do
  138                   home <- getHomeDirectory
  139                   return $ home </> timelogdefaultfilename)
  140 
  141 -- | Read the user's default journal file, or give an error.
  142 myJournal :: IO Journal
  143 myJournal = myJournalPath >>= readJournalFile Nothing >>= either error' return
  144 
  145 -- | Read the user's default timelog file, or give an error.
  146 myTimelog :: IO Journal
  147 myTimelog = myTimelogPath >>= readJournalFile Nothing >>= either error' return
  148 
  149 tests_Hledger_Read = TestList
  150   [
  151    tests_Hledger_Read_JournalReader,
  152    tests_Hledger_Read_TimelogReader,
  153 
  154    "journalFile" ~: do
  155     assertBool "journalFile should parse an empty file" (isRight $ parseWithCtx nullctx JournalReader.journalFile "")
  156     jE <- readJournal Nothing "" -- don't know how to get it from journalFile
  157     either error' (assertBool "journalFile parsing an empty file should give an empty journal" . null . jtxns) jE
  158 
  159   ]