lib: finish move of reading utils, useful for 320
It seems this already began in today's timedot commit.
This commit is contained in:
		
							parent
							
								
									00656e62bf
								
							
						
					
					
						commit
						1cf223a2db
					
				| @ -32,216 +32,27 @@ module Hledger.Read ( | |||||||
|        tests_Hledger_Read, |        tests_Hledger_Read, | ||||||
| ) | ) | ||||||
| where | where | ||||||
| import qualified Control.Exception as C |  | ||||||
| import Control.Monad.Except | import Control.Monad.Except | ||||||
| import Data.List | import Data.List | ||||||
| import Data.Maybe | import Data.Maybe | ||||||
| import System.Directory (doesFileExist, getHomeDirectory) |  | ||||||
| import System.Environment (getEnv) |  | ||||||
| import System.Exit (exitFailure) |  | ||||||
| import System.FilePath ((</>)) |  | ||||||
| import System.IO (IOMode(..), openFile, stdin, stderr, hSetNewlineMode, universalNewlineMode) |  | ||||||
| import Test.HUnit | import Test.HUnit | ||||||
| import Text.Printf |  | ||||||
| 
 | 
 | ||||||
| import Hledger.Data.Dates (getCurrentDay) |  | ||||||
| import Hledger.Data.Types | import Hledger.Data.Types | ||||||
| import Hledger.Data.Journal (nullctx) | import Hledger.Data.Journal (nullctx) | ||||||
|  | import Hledger.Read.Util | ||||||
| import Hledger.Read.JournalReader as JournalReader | import Hledger.Read.JournalReader as JournalReader | ||||||
| import Hledger.Read.TimedotReader as TimedotReader | import Hledger.Read.TimedotReader as TimedotReader | ||||||
| import Hledger.Read.TimelogReader as TimelogReader | import Hledger.Read.TimelogReader as TimelogReader | ||||||
| import Hledger.Read.CsvReader as CsvReader | import Hledger.Read.CsvReader as CsvReader | ||||||
| import Hledger.Utils | import Hledger.Utils | ||||||
| import Prelude hiding (getContents, writeFile) | import Prelude hiding (getContents, writeFile) | ||||||
| import Hledger.Utils.UTF8IOCompat (hGetContents, writeFile) |  | ||||||
| 
 | 
 | ||||||
| 
 | 
 | ||||||
| journalEnvVar           = "LEDGER_FILE" |  | ||||||
| journalEnvVar2          = "LEDGER" |  | ||||||
| journalDefaultFilename  = ".hledger.journal" |  | ||||||
| 
 |  | ||||||
| -- The available data file readers, each one handling a particular data |  | ||||||
| -- format. The first is also used as the default for unknown formats. |  | ||||||
| readers :: [Reader] |  | ||||||
| readers = [ |  | ||||||
|   JournalReader.reader |  | ||||||
|  ,TimelogReader.reader |  | ||||||
|  ,TimedotReader.reader |  | ||||||
|  ,CsvReader.reader |  | ||||||
|  ] |  | ||||||
| 
 |  | ||||||
| -- | All the data formats we can read. |  | ||||||
| -- formats = map rFormat readers |  | ||||||
| 
 |  | ||||||
| -- | Get the default journal file path specified by the environment. |  | ||||||
| -- Like ledger, we look first for the LEDGER_FILE environment |  | ||||||
| -- variable, and if that does not exist, for the legacy LEDGER |  | ||||||
| -- environment variable. If neither is set, or the value is blank, |  | ||||||
| -- return the hard-coded default, which is @.hledger.journal@ in the |  | ||||||
| -- users's home directory (or in the current directory, if we cannot |  | ||||||
| -- determine a home directory). |  | ||||||
| defaultJournalPath :: IO String |  | ||||||
| defaultJournalPath = do |  | ||||||
|   s <- envJournalPath |  | ||||||
|   if null s then defaultJournalPath else return s |  | ||||||
|     where |  | ||||||
|       envJournalPath = |  | ||||||
|         getEnv journalEnvVar |  | ||||||
|          `C.catch` (\(_::C.IOException) -> getEnv journalEnvVar2 |  | ||||||
|                                             `C.catch` (\(_::C.IOException) -> return "")) |  | ||||||
|       defaultJournalPath = do |  | ||||||
|                   home <- getHomeDirectory `C.catch` (\(_::C.IOException) -> return "") |  | ||||||
|                   return $ home </> journalDefaultFilename |  | ||||||
| 
 |  | ||||||
| -- | Read the default journal file specified by the environment, or raise an error. |  | ||||||
| defaultJournal :: IO Journal |  | ||||||
| defaultJournal = defaultJournalPath >>= readJournalFile Nothing Nothing True >>= either error' return |  | ||||||
| 
 |  | ||||||
| -- | Read a journal from the given string, trying all known formats, or simply throw an error. |  | ||||||
| readJournal' :: String -> IO Journal |  | ||||||
| readJournal' s = readJournal Nothing Nothing True Nothing s >>= either error' return |  | ||||||
| 
 |  | ||||||
| tests_readJournal' = [ |  | ||||||
|   "readJournal' parses sample journal" ~: do |  | ||||||
|      _ <- samplejournal |  | ||||||
|      assertBool "" True |  | ||||||
|  ] |  | ||||||
| 
 |  | ||||||
| 
 |  | ||||||
| 
 |  | ||||||
| -- | Read a journal from this string, trying whatever readers seem appropriate: |  | ||||||
| -- |  | ||||||
| -- - if a format is specified, try that reader only |  | ||||||
| -- |  | ||||||
| -- - or if one or more readers recognises the file path and data, try those |  | ||||||
| -- |  | ||||||
| -- - otherwise, try them all. |  | ||||||
| -- |  | ||||||
| -- A CSV conversion rules file may also be specified for use by the CSV reader. |  | ||||||
| -- Also there is a flag specifying whether to check or ignore balance assertions in the journal. |  | ||||||
| readJournal :: Maybe StorageFormat -> Maybe FilePath -> Bool -> Maybe FilePath -> String -> IO (Either String Journal) |  | ||||||
| readJournal format rulesfile assrt path s = |  | ||||||
|   tryReaders $ readersFor (format, path, s) |  | ||||||
|   where |  | ||||||
|     -- try each reader in turn, returning the error of the first if all fail |  | ||||||
|     tryReaders :: [Reader] -> IO (Either String Journal) |  | ||||||
|     tryReaders = firstSuccessOrBestError [] |  | ||||||
|       where |  | ||||||
|         firstSuccessOrBestError :: [String] -> [Reader] -> IO (Either String Journal) |  | ||||||
|         firstSuccessOrBestError [] []        = return $ Left "no readers found" |  | ||||||
|         firstSuccessOrBestError errs (r:rs) = do |  | ||||||
|           dbg1IO "trying reader" (rFormat r) |  | ||||||
|           result <- (runExceptT . (rParser r) rulesfile assrt path') s |  | ||||||
|           dbg1IO "reader result" $ either id show result |  | ||||||
|           case result of Right j -> return $ Right j                       -- success! |  | ||||||
|                          Left e  -> firstSuccessOrBestError (errs++[e]) rs -- keep trying |  | ||||||
|         firstSuccessOrBestError (e:_) []    = return $ Left e              -- none left, return first error |  | ||||||
|         path' = fromMaybe "(string)" path |  | ||||||
| 
 |  | ||||||
| -- | Which readers are worth trying for this (possibly unspecified) format, filepath, and data ? |  | ||||||
| readersFor :: (Maybe StorageFormat, Maybe FilePath, String) -> [Reader] |  | ||||||
| readersFor (format,path,s) = |  | ||||||
|     dbg1 ("possible readers for "++show (format,path,elideRight 30 s)) $ |  | ||||||
|     case format of |  | ||||||
|      Just f  -> case readerForStorageFormat f of Just r  -> [r] |  | ||||||
|                                                  Nothing -> [] |  | ||||||
|      Nothing -> case path of Nothing  -> readers |  | ||||||
|                              Just p   -> case readersForPathAndData (p,s) of [] -> readers |  | ||||||
|                                                                              rs -> rs |  | ||||||
| 
 |  | ||||||
| -- | Find the (first) reader which can handle the given format, if any. |  | ||||||
| readerForStorageFormat :: StorageFormat -> Maybe Reader |  | ||||||
| readerForStorageFormat s | null rs = Nothing |  | ||||||
|                   | otherwise = Just $ head rs |  | ||||||
|     where |  | ||||||
|       rs = filter ((s==).rFormat) readers :: [Reader] |  | ||||||
| 
 |  | ||||||
| -- | Find the readers which think they can handle the given file path and data, if any. |  | ||||||
| readersForPathAndData :: (FilePath,String) -> [Reader] |  | ||||||
| readersForPathAndData (f,s) = filter (\r -> (rDetector r) f s) readers |  | ||||||
| 
 |  | ||||||
| -- | Read a Journal from this file (or stdin if the filename is -) or give |  | ||||||
| -- an error message, using the specified data format or trying all known |  | ||||||
| -- formats. A CSV conversion rules file may be specified for better |  | ||||||
| -- conversion of that format. Also there is a flag specifying whether |  | ||||||
| -- to check or ignore balance assertions in the journal. |  | ||||||
| readJournalFile :: Maybe StorageFormat -> Maybe FilePath -> Bool -> FilePath -> IO (Either String Journal) |  | ||||||
| readJournalFile format rulesfile assrt f = readJournalFiles format rulesfile assrt [f] |  | ||||||
| 
 |  | ||||||
| readJournalFiles :: Maybe StorageFormat -> Maybe FilePath -> Bool -> [FilePath] -> IO (Either String Journal) |  | ||||||
| readJournalFiles format rulesfile assrt f = do |  | ||||||
|   contents <- fmap concat $ mapM readFileAnyNewline f |  | ||||||
|   readJournal format rulesfile assrt (listToMaybe f) contents |  | ||||||
|  where |  | ||||||
|   readFileAnyNewline f = do |  | ||||||
|     requireJournalFileExists f |  | ||||||
|     h <- fileHandle f |  | ||||||
|     hSetNewlineMode h universalNewlineMode |  | ||||||
|     hGetContents h |  | ||||||
|   fileHandle "-" = return stdin |  | ||||||
|   fileHandle f = openFile f ReadMode |  | ||||||
| 
 |  | ||||||
| -- | If the specified journal file does not exist, give a helpful error and quit. |  | ||||||
| requireJournalFileExists :: FilePath -> IO () |  | ||||||
| requireJournalFileExists "-" = return () |  | ||||||
| requireJournalFileExists f = do |  | ||||||
|   exists <- doesFileExist f |  | ||||||
|   when (not exists) $ do |  | ||||||
|     hPrintf stderr "The hledger journal file \"%s\" was not found.\n" f |  | ||||||
|     hPrintf stderr "Please create it first, eg with \"hledger add\" or a text editor.\n" |  | ||||||
|     hPrintf stderr "Or, specify an existing journal file with -f or LEDGER_FILE.\n" |  | ||||||
|     exitFailure |  | ||||||
| 
 |  | ||||||
| -- | Ensure there is a journal file at the given path, creating an empty one if needed. |  | ||||||
| ensureJournalFileExists :: FilePath -> IO () |  | ||||||
| ensureJournalFileExists f = do |  | ||||||
|   exists <- doesFileExist f |  | ||||||
|   when (not exists) $ do |  | ||||||
|     hPrintf stderr "Creating hledger journal file %s.\n" f |  | ||||||
|     -- note Hledger.Utils.UTF8.* do no line ending conversion on windows, |  | ||||||
|     -- we currently require unix line endings on all platforms. |  | ||||||
|     newJournalContent >>= writeFile f |  | ||||||
| 
 |  | ||||||
| -- | Give the content for a new auto-created journal file. |  | ||||||
| newJournalContent :: IO String |  | ||||||
| newJournalContent = do |  | ||||||
|   d <- getCurrentDay |  | ||||||
|   return $ printf "; journal created %s by hledger\n" (show d) |  | ||||||
| 
 |  | ||||||
| -- tests |  | ||||||
| 
 |  | ||||||
| samplejournal = readJournal' $ unlines |  | ||||||
|  ["2008/01/01 income" |  | ||||||
|  ,"    assets:bank:checking  $1" |  | ||||||
|  ,"    income:salary" |  | ||||||
|  ,"" |  | ||||||
|  ,"comment" |  | ||||||
|  ,"multi line comment here" |  | ||||||
|  ,"for testing purposes" |  | ||||||
|  ,"end comment" |  | ||||||
|  ,"" |  | ||||||
|  ,"2008/06/01 gift" |  | ||||||
|  ,"    assets:bank:checking  $1" |  | ||||||
|  ,"    income:gifts" |  | ||||||
|  ,"" |  | ||||||
|  ,"2008/06/02 save" |  | ||||||
|  ,"    assets:bank:saving  $1" |  | ||||||
|  ,"    assets:bank:checking" |  | ||||||
|  ,"" |  | ||||||
|  ,"2008/06/03 * eat & shop" |  | ||||||
|  ,"    expenses:food      $1" |  | ||||||
|  ,"    expenses:supplies  $1" |  | ||||||
|  ,"    assets:cash" |  | ||||||
|  ,"" |  | ||||||
|  ,"2008/12/31 * pay off" |  | ||||||
|  ,"    liabilities:debts  $1" |  | ||||||
|  ,"    assets:bank:checking" |  | ||||||
|  ] |  | ||||||
| 
 |  | ||||||
| tests_Hledger_Read = TestList $ | tests_Hledger_Read = TestList $ | ||||||
|   tests_readJournal' |   tests_readJournal' | ||||||
|   ++ [ |   ++ [ | ||||||
|    tests_Hledger_Read_JournalReader, |    tests_Hledger_Read_JournalReader, | ||||||
|  |    tests_Hledger_Read_TimedotReader, | ||||||
|    tests_Hledger_Read_TimelogReader, |    tests_Hledger_Read_TimelogReader, | ||||||
|    tests_Hledger_Read_CsvReader, |    tests_Hledger_Read_CsvReader, | ||||||
| 
 | 
 | ||||||
|  | |||||||
| @ -104,6 +104,7 @@ library | |||||||
|       Hledger.Read.JournalReader |       Hledger.Read.JournalReader | ||||||
|       Hledger.Read.TimedotReader |       Hledger.Read.TimedotReader | ||||||
|       Hledger.Read.TimelogReader |       Hledger.Read.TimelogReader | ||||||
|  |       Hledger.Read.Util | ||||||
|       Hledger.Reports |       Hledger.Reports | ||||||
|       Hledger.Reports.ReportOptions |       Hledger.Reports.ReportOptions | ||||||
|       Hledger.Reports.BalanceHistoryReport |       Hledger.Reports.BalanceHistoryReport | ||||||
|  | |||||||
| @ -115,6 +115,7 @@ library: | |||||||
|     - Hledger.Read.JournalReader |     - Hledger.Read.JournalReader | ||||||
|     - Hledger.Read.TimedotReader |     - Hledger.Read.TimedotReader | ||||||
|     - Hledger.Read.TimelogReader |     - Hledger.Read.TimelogReader | ||||||
|  |     - Hledger.Read.Util | ||||||
|     - Hledger.Reports |     - Hledger.Reports | ||||||
|     - Hledger.Reports.ReportOptions |     - Hledger.Reports.ReportOptions | ||||||
|     - Hledger.Reports.BalanceHistoryReport |     - Hledger.Reports.BalanceHistoryReport | ||||||
|  | |||||||
		Loading…
	
		Reference in New Issue
	
	Block a user