lib: textification: parse stream
10% more allocation, but 35% lower maximum residency, and slightly quicker. hledger -f data/100x100x10.journal stats <<ghc: 39327768 bytes, 77 GCs, 196834/269496 avg/max bytes residency (3 samples), 2M in use, 0.000 INIT (0.010 elapsed), 0.020 MUT (0.092 elapsed), 0.014 GC (0.119 elapsed) :ghc>> <<ghc: 42842136 bytes, 84 GCs, 194010/270912 avg/max bytes residency (3 samples), 2M in use, 0.000 INIT (0.009 elapsed), 0.016 MUT (0.029 elapsed), 0.012 GC (0.120 elapsed) :ghc>> hledger -f data/1000x1000x10.journal stats <<ghc: 314291440 bytes, 612 GCs, 2070776/6628048 avg/max bytes residency (7 samples), 16M in use, 0.000 INIT (0.000 elapsed), 0.128 MUT (0.144 elapsed), 0.059 GC (0.070 elapsed) :ghc>> <<ghc: 349558872 bytes, 681 GCs, 1397597/4106384 avg/max bytes residency (7 samples), 11M in use, 0.000 INIT (0.004 elapsed), 0.124 MUT (0.133 elapsed), 0.047 GC (0.053 elapsed) :ghc>> hledger -f data/10000x1000x10.journal stats <<ghc: 3070026824 bytes, 5973 GCs, 12698030/62951784 avg/max bytes residency (10 samples), 124M in use, 0.000 INIT (0.002 elapsed), 1.268 MUT (1.354 elapsed), 0.514 GC (0.587 elapsed) :ghc>> <<ghc: 3424013128 bytes, 6658 GCs, 11405501/41071624 avg/max bytes residency (11 samples), 111M in use, 0.000 INIT (0.001 elapsed), 1.343 MUT (1.406 elapsed), 0.511 GC (0.573 elapsed) :ghc>> hledger -f data/100000x1000x10.journal stats <<ghc: 30753387392 bytes, 59811 GCs, 117615462/666703600 avg/max bytes residency (14 samples), 1588M in use, 0.000 INIT (0.000 elapsed), 12.068 MUT (12.238 elapsed), 6.015 GC (7.190 elapsed) :ghc>> <<ghc: 34306530696 bytes, 66727 GCs, 76806196/414629312 avg/max bytes residency (14 samples), 1009M in use, 0.000 INIT (0.010 elapsed), 14.357 MUT (16.370 elapsed), 5.298 GC (6.534 elapsed) :ghc>>
This commit is contained in:
Simon Michael
parent
58c3362908
commit
c89c33b36e
@ -579,14 +579,14 @@ and maybe some others:
|
||||
Returns a SmartDate, to be converted to a full date later (see fixSmartDate).
|
||||
Assumes any text in the parse stream has been lowercased.
|
||||
-}
|
||||
smartdate :: Stream [Char] m Char => ParsecT [Char] st m SmartDate
|
||||
smartdate :: Stream s m Char => ParsecT s st m SmartDate
|
||||
smartdate = do
|
||||
-- XXX maybe obscures date errors ? see ledgerdate
|
||||
(y,m,d) <- choice' [yyyymmdd, ymd, ym, md, y, d, month, mon, today, yesterday, tomorrow, lastthisnextthing]
|
||||
return (y,m,d)
|
||||
|
||||
-- | Like smartdate, but there must be nothing other than whitespace after the date.
|
||||
smartdateonly :: Stream [Char] m Char => ParsecT [Char] st m SmartDate
|
||||
smartdateonly :: Stream s m Char => ParsecT s st m SmartDate
|
||||
smartdateonly = do
|
||||
d <- smartdate
|
||||
many spacenonewline
|
||||
@ -594,7 +594,7 @@ smartdateonly = do
|
||||
return d
|
||||
|
||||
datesepchars = "/-."
|
||||
datesepchar :: Stream [Char] m Char => ParsecT [Char] st m Char
|
||||
datesepchar :: Stream s m Char => ParsecT s st m Char
|
||||
datesepchar = oneOf datesepchars
|
||||
|
||||
validYear, validMonth, validDay :: String -> Bool
|
||||
@ -607,7 +607,7 @@ failIfInvalidYear s = unless (validYear s) $ fail $ "bad year number: " ++ s
|
||||
failIfInvalidMonth s = unless (validMonth s) $ fail $ "bad month number: " ++ s
|
||||
failIfInvalidDay s = unless (validDay s) $ fail $ "bad day number: " ++ s
|
||||
|
||||
yyyymmdd :: Stream [Char] m Char => ParsecT [Char] st m SmartDate
|
||||
yyyymmdd :: Stream s m Char => ParsecT s st m SmartDate
|
||||
yyyymmdd = do
|
||||
y <- count 4 digit
|
||||
m <- count 2 digit
|
||||
@ -616,7 +616,7 @@ yyyymmdd = do
|
||||
failIfInvalidDay d
|
||||
return (y,m,d)
|
||||
|
||||
ymd :: Stream [Char] m Char => ParsecT [Char] st m SmartDate
|
||||
ymd :: Stream s m Char => ParsecT s st m SmartDate
|
||||
ymd = do
|
||||
y <- many1 digit
|
||||
failIfInvalidYear y
|
||||
@ -628,7 +628,7 @@ ymd = do
|
||||
failIfInvalidDay d
|
||||
return $ (y,m,d)
|
||||
|
||||
ym :: Stream [Char] m Char => ParsecT [Char] st m SmartDate
|
||||
ym :: Stream s m Char => ParsecT s st m SmartDate
|
||||
ym = do
|
||||
y <- many1 digit
|
||||
failIfInvalidYear y
|
||||
@ -637,19 +637,19 @@ ym = do
|
||||
failIfInvalidMonth m
|
||||
return (y,m,"")
|
||||
|
||||
y :: Stream [Char] m Char => ParsecT [Char] st m SmartDate
|
||||
y :: Stream s m Char => ParsecT s st m SmartDate
|
||||
y = do
|
||||
y <- many1 digit
|
||||
failIfInvalidYear y
|
||||
return (y,"","")
|
||||
|
||||
d :: Stream [Char] m Char => ParsecT [Char] st m SmartDate
|
||||
d :: Stream s m Char => ParsecT s st m SmartDate
|
||||
d = do
|
||||
d <- many1 digit
|
||||
failIfInvalidDay d
|
||||
return ("","",d)
|
||||
|
||||
md :: Stream [Char] m Char => ParsecT [Char] st m SmartDate
|
||||
md :: Stream s m Char => ParsecT s st m SmartDate
|
||||
md = do
|
||||
m <- many1 digit
|
||||
failIfInvalidMonth m
|
||||
@ -667,24 +667,24 @@ monthabbrevs = ["jan","feb","mar","apr","may","jun","jul","aug","sep","oct","n
|
||||
monthIndex s = maybe 0 (+1) $ lowercase s `elemIndex` months
|
||||
monIndex s = maybe 0 (+1) $ lowercase s `elemIndex` monthabbrevs
|
||||
|
||||
month :: Stream [Char] m Char => ParsecT [Char] st m SmartDate
|
||||
month :: Stream s m Char => ParsecT s st m SmartDate
|
||||
month = do
|
||||
m <- choice $ map (try . string) months
|
||||
let i = monthIndex m
|
||||
return ("",show i,"")
|
||||
|
||||
mon :: Stream [Char] m Char => ParsecT [Char] st m SmartDate
|
||||
mon :: Stream s m Char => ParsecT s st m SmartDate
|
||||
mon = do
|
||||
m <- choice $ map (try . string) monthabbrevs
|
||||
let i = monIndex m
|
||||
return ("",show i,"")
|
||||
|
||||
today,yesterday,tomorrow :: Stream [Char] m Char => ParsecT [Char] st m SmartDate
|
||||
today,yesterday,tomorrow :: Stream s m Char => ParsecT s st m SmartDate
|
||||
today = string "today" >> return ("","","today")
|
||||
yesterday = string "yesterday" >> return ("","","yesterday")
|
||||
tomorrow = string "tomorrow" >> return ("","","tomorrow")
|
||||
|
||||
lastthisnextthing :: Stream [Char] m Char => ParsecT [Char] st m SmartDate
|
||||
lastthisnextthing :: Stream s m Char => ParsecT s st m SmartDate
|
||||
lastthisnextthing = do
|
||||
r <- choice [
|
||||
string "last"
|
||||
@ -716,7 +716,7 @@ lastthisnextthing = do
|
||||
-- Right (Days 1,DateSpan 2008/08/01-)
|
||||
-- >>> p "every week to 2009"
|
||||
-- Right (Weeks 1,DateSpan -2008/12/31)
|
||||
periodexpr :: Stream [Char] m Char => Day -> ParsecT [Char] st m (Interval, DateSpan)
|
||||
periodexpr :: Stream s m Char => Day -> ParsecT s st m (Interval, DateSpan)
|
||||
periodexpr rdate = choice $ map try [
|
||||
intervalanddateperiodexpr rdate,
|
||||
intervalperiodexpr,
|
||||
@ -724,7 +724,7 @@ periodexpr rdate = choice $ map try [
|
||||
(return (NoInterval,DateSpan Nothing Nothing))
|
||||
]
|
||||
|
||||
intervalanddateperiodexpr :: Stream [Char] m Char => Day -> ParsecT [Char] st m (Interval, DateSpan)
|
||||
intervalanddateperiodexpr :: Stream s m Char => Day -> ParsecT s st m (Interval, DateSpan)
|
||||
intervalanddateperiodexpr rdate = do
|
||||
many spacenonewline
|
||||
i <- reportinginterval
|
||||
@ -732,20 +732,20 @@ intervalanddateperiodexpr rdate = do
|
||||
s <- periodexprdatespan rdate
|
||||
return (i,s)
|
||||
|
||||
intervalperiodexpr :: Stream [Char] m Char => ParsecT [Char] st m (Interval, DateSpan)
|
||||
intervalperiodexpr :: Stream s m Char => ParsecT s st m (Interval, DateSpan)
|
||||
intervalperiodexpr = do
|
||||
many spacenonewline
|
||||
i <- reportinginterval
|
||||
return (i, DateSpan Nothing Nothing)
|
||||
|
||||
dateperiodexpr :: Stream [Char] m Char => Day -> ParsecT [Char] st m (Interval, DateSpan)
|
||||
dateperiodexpr :: Stream s m Char => Day -> ParsecT s st m (Interval, DateSpan)
|
||||
dateperiodexpr rdate = do
|
||||
many spacenonewline
|
||||
s <- periodexprdatespan rdate
|
||||
return (NoInterval, s)
|
||||
|
||||
-- Parse a reporting interval.
|
||||
reportinginterval :: Stream [Char] m Char => ParsecT [Char] st m Interval
|
||||
reportinginterval :: Stream s m Char => ParsecT s st m Interval
|
||||
reportinginterval = choice' [
|
||||
tryinterval "day" "daily" Days,
|
||||
tryinterval "week" "weekly" Weeks,
|
||||
@ -785,7 +785,7 @@ reportinginterval = choice' [
|
||||
thsuffix = choice' $ map string ["st","nd","rd","th"]
|
||||
|
||||
-- Parse any of several variants of a basic interval, eg "daily", "every day", "every N days".
|
||||
tryinterval :: Stream [Char] m Char => String -> String -> (Int -> Interval) -> ParsecT [Char] st m Interval
|
||||
tryinterval :: Stream s m Char => String -> String -> (Int -> Interval) -> ParsecT s st m Interval
|
||||
tryinterval singular compact intcons =
|
||||
choice' [
|
||||
do string compact
|
||||
@ -803,7 +803,7 @@ reportinginterval = choice' [
|
||||
]
|
||||
where plural = singular ++ "s"
|
||||
|
||||
periodexprdatespan :: Stream [Char] m Char => Day -> ParsecT [Char] st m DateSpan
|
||||
periodexprdatespan :: Stream s m Char => Day -> ParsecT s st m DateSpan
|
||||
periodexprdatespan rdate = choice $ map try [
|
||||
doubledatespan rdate,
|
||||
fromdatespan rdate,
|
||||
@ -811,7 +811,7 @@ periodexprdatespan rdate = choice $ map try [
|
||||
justdatespan rdate
|
||||
]
|
||||
|
||||
doubledatespan :: Stream [Char] m Char => Day -> ParsecT [Char] st m DateSpan
|
||||
doubledatespan :: Stream s m Char => Day -> ParsecT s st m DateSpan
|
||||
doubledatespan rdate = do
|
||||
optional (string "from" >> many spacenonewline)
|
||||
b <- smartdate
|
||||
@ -820,7 +820,7 @@ doubledatespan rdate = do
|
||||
e <- smartdate
|
||||
return $ DateSpan (Just $ fixSmartDate rdate b) (Just $ fixSmartDate rdate e)
|
||||
|
||||
fromdatespan :: Stream [Char] m Char => Day -> ParsecT [Char] st m DateSpan
|
||||
fromdatespan :: Stream s m Char => Day -> ParsecT s st m DateSpan
|
||||
fromdatespan rdate = do
|
||||
b <- choice [
|
||||
do
|
||||
@ -834,13 +834,13 @@ fromdatespan rdate = do
|
||||
]
|
||||
return $ DateSpan (Just $ fixSmartDate rdate b) Nothing
|
||||
|
||||
todatespan :: Stream [Char] m Char => Day -> ParsecT [Char] st m DateSpan
|
||||
todatespan :: Stream s m Char => Day -> ParsecT s st m DateSpan
|
||||
todatespan rdate = do
|
||||
choice [string "to", string "-"] >> many spacenonewline
|
||||
e <- smartdate
|
||||
return $ DateSpan Nothing (Just $ fixSmartDate rdate e)
|
||||
|
||||
justdatespan :: Stream [Char] m Char => Day -> ParsecT [Char] st m DateSpan
|
||||
justdatespan :: Stream s m Char => Day -> ParsecT s st m DateSpan
|
||||
justdatespan rdate = do
|
||||
optional (string "in" >> many spacenonewline)
|
||||
d <- smartdate
|
||||
|
||||
@ -277,9 +277,9 @@ data Reader = Reader {
|
||||
-- name of the format this reader handles
|
||||
rFormat :: StorageFormat
|
||||
-- quickly check if this reader can probably handle the given file path and file content
|
||||
,rDetector :: FilePath -> String -> Bool
|
||||
,rDetector :: FilePath -> Text -> Bool
|
||||
-- parse the given string, using the given parse rules file if any, returning a journal or error aware of the given file path
|
||||
,rParser :: Maybe FilePath -> Bool -> FilePath -> String -> ExceptT String IO Journal
|
||||
,rParser :: Maybe FilePath -> Bool -> FilePath -> Text -> ExceptT String IO Journal
|
||||
}
|
||||
|
||||
instance Show Reader where show r = rFormat r ++ " reader"
|
||||
|
||||
@ -1,4 +1,3 @@
|
||||
{-# LANGUAGE ScopedTypeVariables #-}
|
||||
{-|
|
||||
|
||||
This is the entry point to hledger's reading system, which can read
|
||||
@ -8,6 +7,8 @@ to import modules below this one.
|
||||
|
||||
-}
|
||||
|
||||
{-# LANGUAGE ScopedTypeVariables, OverloadedStrings #-}
|
||||
|
||||
module Hledger.Read
|
||||
(
|
||||
module Hledger.Read.Common,
|
||||
@ -39,11 +40,13 @@ import qualified Control.Exception as C
|
||||
import Control.Monad.Except
|
||||
import Data.List
|
||||
import Data.Maybe
|
||||
import Data.Text (Text)
|
||||
import qualified Data.Text as T
|
||||
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 System.IO (stderr)
|
||||
import Test.HUnit
|
||||
import Text.Printf
|
||||
|
||||
@ -56,7 +59,7 @@ import Hledger.Read.TimeclockReader as TimeclockReader
|
||||
import Hledger.Read.CsvReader as CsvReader
|
||||
import Hledger.Utils
|
||||
import Prelude hiding (getContents, writeFile)
|
||||
import Hledger.Utils.UTF8IOCompat (hGetContents, writeFile)
|
||||
import Hledger.Utils.UTF8IOCompat (writeFile)
|
||||
|
||||
|
||||
-- The available data file readers, each one handling a particular data
|
||||
@ -77,14 +80,14 @@ journalEnvVar2 = "LEDGER"
|
||||
journalDefaultFilename = ".hledger.journal"
|
||||
|
||||
-- | 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)) $
|
||||
readersFor :: (Maybe StorageFormat, Maybe FilePath, Text) -> [Reader]
|
||||
readersFor (format,path,t) =
|
||||
dbg1 ("possible readers for "++show (format,path,textElideRight 30 t)) $
|
||||
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
|
||||
Just p -> case readersForPathAndData (p,t) of [] -> readers
|
||||
rs -> rs
|
||||
|
||||
-- | Find the (first) reader which can handle the given format, if any.
|
||||
@ -95,18 +98,18 @@ readerForStorageFormat s | null rs = Nothing
|
||||
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
|
||||
readersForPathAndData :: (FilePath,Text) -> [Reader]
|
||||
readersForPathAndData (f,t) = filter (\r -> (rDetector r) f t) readers
|
||||
|
||||
-- try each reader in turn, returning the error of the first if all fail
|
||||
tryReaders :: [Reader] -> Maybe FilePath -> Bool -> Maybe FilePath -> String -> IO (Either String Journal)
|
||||
tryReaders readers mrulesfile assrt path s = firstSuccessOrBestError [] readers
|
||||
tryReaders :: [Reader] -> Maybe FilePath -> Bool -> Maybe FilePath -> Text -> IO (Either String Journal)
|
||||
tryReaders readers mrulesfile assrt path t = firstSuccessOrBestError [] readers
|
||||
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) mrulesfile assrt path') s
|
||||
result <- (runExceptT . (rParser r) mrulesfile assrt path') t
|
||||
dbg1IO "reader result" $ either id show result
|
||||
case result of Right j -> return $ Right j -- success!
|
||||
Left e -> firstSuccessOrBestError (errs++[e]) rs -- keep trying
|
||||
@ -124,8 +127,8 @@ tryReaders readers mrulesfile assrt path s = firstSuccessOrBestError [] readers
|
||||
--
|
||||
-- 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 mformat mrulesfile assrt mpath s = tryReaders (readersFor (mformat, mpath, s)) mrulesfile assrt mpath s
|
||||
readJournal :: Maybe StorageFormat -> Maybe FilePath -> Bool -> Maybe FilePath -> Text -> IO (Either String Journal)
|
||||
readJournal mformat mrulesfile assrt mpath t = tryReaders (readersFor (mformat, mpath, t)) mrulesfile assrt mpath t
|
||||
|
||||
-- | 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
|
||||
@ -133,20 +136,9 @@ readJournal mformat mrulesfile assrt mpath s = tryReaders (readersFor (mformat,
|
||||
-- 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 mformat mrulesfile assrt f =
|
||||
readFileOrStdinAnyNewline f >>= readJournal mformat mrulesfile assrt (Just f)
|
||||
|
||||
-- | Read the given file, or standard input if the path is "-", using
|
||||
-- universal newline mode.
|
||||
readFileOrStdinAnyNewline :: String -> IO String
|
||||
readFileOrStdinAnyNewline f = do
|
||||
requireJournalFileExists f
|
||||
h <- fileHandle f
|
||||
hSetNewlineMode h universalNewlineMode
|
||||
hGetContents h
|
||||
where
|
||||
fileHandle "-" = return stdin
|
||||
fileHandle f = openFile f ReadMode
|
||||
readJournalFile mformat mrulesfile assrt f = do
|
||||
-- requireJournalFileExists f -- XXX ?
|
||||
readFileOrStdinAnyLineEnding f >>= readJournal mformat mrulesfile assrt (Just f)
|
||||
|
||||
-- | Call readJournalFile on each specified file path, and combine the
|
||||
-- resulting journals into one. If there are any errors, the first is
|
||||
@ -165,12 +157,13 @@ requireJournalFileExists :: FilePath -> IO ()
|
||||
requireJournalFileExists "-" = return ()
|
||||
requireJournalFileExists f = do
|
||||
exists <- doesFileExist f
|
||||
when (not exists) $ do
|
||||
when (not exists) $ do -- XXX might not be a journal file
|
||||
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
|
||||
@ -211,9 +204,9 @@ defaultJournalPath = do
|
||||
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
|
||||
-- | Read a journal from the given text, trying all known formats, or simply throw an error.
|
||||
readJournal' :: Text -> IO Journal
|
||||
readJournal' t = readJournal Nothing Nothing True Nothing t >>= either error' return
|
||||
|
||||
tests_readJournal' = [
|
||||
"readJournal' parses sample journal" ~: do
|
||||
@ -223,7 +216,7 @@ tests_readJournal' = [
|
||||
|
||||
-- tests
|
||||
|
||||
samplejournal = readJournal' $ unlines
|
||||
samplejournal = readJournal' $ T.unlines
|
||||
["2008/01/01 income"
|
||||
," assets:bank:checking $1"
|
||||
," income:salary"
|
||||
|
||||
@ -27,6 +27,7 @@ import Data.Functor.Identity
|
||||
import Data.List.Compat
|
||||
import Data.List.Split (wordsBy)
|
||||
import Data.Maybe
|
||||
-- import Data.Monoid
|
||||
import Data.Text (Text)
|
||||
import qualified Data.Text as T
|
||||
import Data.Time.Calendar
|
||||
@ -44,8 +45,11 @@ import Hledger.Utils
|
||||
-- | A parser of strings with generic user state, monad and return type.
|
||||
type StringParser u m a = ParsecT String u m a
|
||||
|
||||
-- | A string parser with journal-parsing state.
|
||||
type JournalParser m a = StringParser Journal m a
|
||||
-- | A parser of strict text with generic user state, monad and return type.
|
||||
type TextParser u m a = ParsecT Text u m a
|
||||
|
||||
-- | A text parser with journal-parsing state.
|
||||
type JournalParser m a = TextParser Journal m a
|
||||
|
||||
-- | A journal parser that runs in IO and can throw an error mid-parse.
|
||||
type ErroringJournalParser a = JournalParser (ExceptT String IO) a
|
||||
@ -55,14 +59,19 @@ runStringParser, rsp :: StringParser () Identity a -> String -> Either ParseErro
|
||||
runStringParser p s = runIdentity $ runParserT p () "" s
|
||||
rsp = runStringParser
|
||||
|
||||
-- | Run a string parser with no state in the identity monad.
|
||||
runTextParser, rtp :: TextParser () Identity a -> Text -> Either ParseError a
|
||||
runTextParser p t = runIdentity $ runParserT p () "" t
|
||||
rtp = runTextParser
|
||||
|
||||
-- | Run a journal parser with a null journal-parsing state.
|
||||
runJournalParser, rjp :: Monad m => JournalParser m a -> String -> m (Either ParseError a)
|
||||
runJournalParser p s = runParserT p mempty "" s
|
||||
runJournalParser, rjp :: Monad m => JournalParser m a -> Text -> m (Either ParseError a)
|
||||
runJournalParser p t = runParserT p mempty "" t
|
||||
rjp = runJournalParser
|
||||
|
||||
-- | Run an error-raising journal parser with a null journal-parsing state.
|
||||
runErroringJournalParser, rejp :: ErroringJournalParser a -> String -> IO (Either String a)
|
||||
runErroringJournalParser p s = runExceptT $ runJournalParser p s >>= either (throwError.show) return
|
||||
runErroringJournalParser, rejp :: ErroringJournalParser a -> Text -> IO (Either String a)
|
||||
runErroringJournalParser p t = runExceptT $ runJournalParser p t >>= either (throwError.show) return
|
||||
rejp = runErroringJournalParser
|
||||
|
||||
genericSourcePos :: SourcePos -> GenericSourcePos
|
||||
@ -70,13 +79,13 @@ genericSourcePos p = GenericSourcePos (sourceName p) (sourceLine p) (sourceColum
|
||||
|
||||
-- | Given a parsec ParsedJournal parser, file path and data string,
|
||||
-- parse and post-process a ready-to-use Journal, or give an error.
|
||||
parseAndFinaliseJournal :: ErroringJournalParser ParsedJournal -> Bool -> FilePath -> String -> ExceptT String IO Journal
|
||||
parseAndFinaliseJournal parser assrt f s = do
|
||||
parseAndFinaliseJournal :: ErroringJournalParser ParsedJournal -> Bool -> FilePath -> Text -> ExceptT String IO Journal
|
||||
parseAndFinaliseJournal parser assrt f txt = do
|
||||
t <- liftIO getClockTime
|
||||
y <- liftIO getCurrentYear
|
||||
ep <- runParserT parser nulljournal{jparsedefaultyear=Just y} f s
|
||||
ep <- runParserT parser nulljournal{jparsedefaultyear=Just y} f txt
|
||||
case ep of
|
||||
Right pj -> case journalFinalise t f (T.pack s) assrt pj of
|
||||
Right pj -> case journalFinalise t f txt assrt pj of
|
||||
Right j -> return j
|
||||
Left e -> throwError e
|
||||
Left e -> throwError $ show e
|
||||
@ -271,7 +280,7 @@ modifiedaccountnamep = do
|
||||
-- spaces (or end of input). Also they have one or more components of
|
||||
-- at least one character, separated by the account separator char.
|
||||
-- (This parser will also consume one following space, if present.)
|
||||
accountnamep :: Monad m => StringParser u m AccountName
|
||||
accountnamep :: Monad m => TextParser u m AccountName
|
||||
accountnamep = do
|
||||
astr <- do
|
||||
c <- nonspace
|
||||
@ -338,8 +347,8 @@ test_amountp = do
|
||||
-- | Parse an amount from a string, or get an error.
|
||||
amountp' :: String -> Amount
|
||||
amountp' s =
|
||||
case runParser (amountp <* eof) mempty "" s of
|
||||
Right t -> t
|
||||
case runParser (amountp <* eof) mempty "" (T.pack s) of
|
||||
Right amt -> amt
|
||||
Left err -> error' $ show err -- XXX should throwError
|
||||
|
||||
-- | Parse a mixed amount from a string, or get an error.
|
||||
@ -585,7 +594,7 @@ followingcommentandtagsp mdefdate = do
|
||||
-- Save the starting position and preserve all whitespace for the subsequent re-parsing,
|
||||
-- to get good error positions.
|
||||
startpos <- getPosition
|
||||
commentandwhitespace <- do
|
||||
commentandwhitespace :: String <- do
|
||||
let semicoloncommentp' = (:) <$> char ';' <*> anyChar `manyTill` eolof
|
||||
sp1 <- many spacenonewline
|
||||
l1 <- try semicoloncommentp' <|> (newline >> return "")
|
||||
@ -596,13 +605,13 @@ followingcommentandtagsp mdefdate = do
|
||||
-- pdbg 0 $ "comment:"++show comment
|
||||
|
||||
-- Reparse the comment for any tags.
|
||||
tags <- case runStringParser (setPosition startpos >> tagsp) commentandwhitespace of
|
||||
tags <- case runTextParser (setPosition startpos >> tagsp) $ T.pack commentandwhitespace of
|
||||
Right ts -> return ts
|
||||
Left e -> throwError $ show e
|
||||
-- pdbg 0 $ "tags: "++show tags
|
||||
|
||||
-- Reparse the comment for any posting dates. Use the transaction date for defaults, if provided.
|
||||
epdates <- liftIO $ rejp (setPosition startpos >> postingdatesp mdefdate) commentandwhitespace
|
||||
epdates <- liftIO $ rejp (setPosition startpos >> postingdatesp mdefdate) $ T.pack commentandwhitespace
|
||||
pdates <- case epdates of
|
||||
Right ds -> return ds
|
||||
Left e -> throwError e
|
||||
@ -645,14 +654,14 @@ commentStartingWithp cs = do
|
||||
-- >>> commentTags "\na b:, \nd:e, f"
|
||||
-- [("b",""),("d","e")]
|
||||
--
|
||||
commentTags :: String -> [Tag]
|
||||
commentTags :: Text -> [Tag]
|
||||
commentTags s =
|
||||
case runStringParser tagsp s of
|
||||
case runTextParser tagsp s of
|
||||
Right r -> r
|
||||
Left _ -> [] -- shouldn't happen
|
||||
|
||||
-- | Parse all tags found in a string.
|
||||
tagsp :: StringParser u Identity [Tag]
|
||||
tagsp :: TextParser u Identity [Tag]
|
||||
tagsp = -- do
|
||||
-- pdbg 0 $ "tagsp"
|
||||
many (try (nontagp >> tagp))
|
||||
@ -661,7 +670,7 @@ tagsp = -- do
|
||||
--
|
||||
-- >>> rsp nontagp "\na b:, \nd:e, f"
|
||||
-- Right "\na "
|
||||
nontagp :: StringParser u Identity String
|
||||
nontagp :: TextParser u Identity String
|
||||
nontagp = -- do
|
||||
-- pdbg 0 "nontagp"
|
||||
-- anyChar `manyTill` (lookAhead (try (tagorbracketeddatetagsp Nothing >> return ()) <|> eof))
|
||||
@ -675,7 +684,7 @@ nontagp = -- do
|
||||
-- >>> rsp tagp "a:b b , c AuxDate: 4/2"
|
||||
-- Right ("a","b b")
|
||||
--
|
||||
tagp :: Monad m => StringParser u m Tag
|
||||
tagp :: Monad m => TextParser u m Tag
|
||||
tagp = do
|
||||
-- pdbg 0 "tagp"
|
||||
n <- tagnamep
|
||||
@ -685,12 +694,12 @@ tagp = do
|
||||
-- |
|
||||
-- >>> rsp tagnamep "a:"
|
||||
-- Right "a"
|
||||
tagnamep :: Monad m => StringParser u m String
|
||||
tagnamep :: Monad m => TextParser u m String
|
||||
tagnamep = -- do
|
||||
-- pdbg 0 "tagnamep"
|
||||
many1 (noneOf ": \t\n") <* char ':'
|
||||
|
||||
tagvaluep :: Monad m => StringParser u m String
|
||||
tagvaluep :: Monad m => TextParser u m String
|
||||
tagvaluep = do
|
||||
-- ptrace "tagvalue"
|
||||
v <- anyChar `manyTill` (void (try (char ',')) <|> eolof)
|
||||
@ -746,14 +755,14 @@ datetagp mdefdate = do
|
||||
(do
|
||||
setPosition startpos
|
||||
datep) -- <* eof)
|
||||
v
|
||||
(T.pack v)
|
||||
case ep
|
||||
of Left e -> throwError $ show e
|
||||
Right d -> return ("date"++n, d)
|
||||
|
||||
--- ** bracketed dates
|
||||
|
||||
-- tagorbracketeddatetagsp :: Monad m => Maybe Day -> StringParser u m [Tag]
|
||||
-- tagorbracketeddatetagsp :: Monad m => Maybe Day -> TextParser u m [Tag]
|
||||
-- tagorbracketeddatetagsp mdefdate =
|
||||
-- bracketeddatetagsp mdefdate <|> ((:[]) <$> tagp)
|
||||
|
||||
@ -807,7 +816,7 @@ bracketeddatetagsp mdefdate = do
|
||||
eof
|
||||
return (md1,md2)
|
||||
)
|
||||
s
|
||||
(T.pack s)
|
||||
case ep
|
||||
of Left e -> throwError $ show e
|
||||
Right (md1,md2) -> return $ catMaybes
|
||||
|
||||
@ -30,7 +30,7 @@ import Data.Char (toLower, isDigit, isSpace)
|
||||
import Data.List.Compat
|
||||
import Data.Maybe
|
||||
import Data.Ord
|
||||
-- import Data.Text (Text)
|
||||
import Data.Text (Text)
|
||||
import qualified Data.Text as T
|
||||
import Data.Time.Calendar (Day)
|
||||
#if MIN_VERSION_time(1,5,0)
|
||||
@ -63,16 +63,16 @@ format :: String
|
||||
format = "csv"
|
||||
|
||||
-- | Does the given file path and data look like it might be CSV ?
|
||||
detect :: FilePath -> String -> Bool
|
||||
detect f s
|
||||
detect :: FilePath -> Text -> Bool
|
||||
detect f t
|
||||
| f /= "-" = takeExtension f == '.':format -- from a file: yes if the extension is .csv
|
||||
| otherwise = length (filter (==',') s) >= 2 -- from stdin: yes if there are two or more commas
|
||||
| otherwise = T.length (T.filter (==',') t) >= 2 -- from stdin: yes if there are two or more commas
|
||||
|
||||
-- | Parse and post-process a "Journal" from CSV data, or give an error.
|
||||
-- XXX currently ignores the string and reads from the file path
|
||||
parse :: Maybe FilePath -> Bool -> FilePath -> String -> ExceptT String IO Journal
|
||||
parse rulesfile _ f s = do
|
||||
r <- liftIO $ readJournalFromCsv rulesfile f s
|
||||
parse :: Maybe FilePath -> Bool -> FilePath -> Text -> ExceptT String IO Journal
|
||||
parse rulesfile _ f t = do
|
||||
r <- liftIO $ readJournalFromCsv rulesfile f t
|
||||
case r of Left e -> throwError e
|
||||
Right j -> return j
|
||||
|
||||
@ -87,7 +87,7 @@ parse rulesfile _ f s = do
|
||||
-- 4. parse the rules file
|
||||
-- 5. convert the CSV records to a journal using the rules
|
||||
-- @
|
||||
readJournalFromCsv :: Maybe FilePath -> FilePath -> String -> IO (Either String Journal)
|
||||
readJournalFromCsv :: Maybe FilePath -> FilePath -> Text -> IO (Either String Journal)
|
||||
readJournalFromCsv Nothing "-" _ = return $ Left "please use --rules-file when reading CSV from stdin"
|
||||
readJournalFromCsv mrulesfile csvfile csvdata =
|
||||
handle (\e -> return $ Left $ show (e :: IOException)) $ do
|
||||
@ -117,7 +117,7 @@ readJournalFromCsv mrulesfile csvfile csvdata =
|
||||
records <- (either throwerr id .
|
||||
dbg2 "validateCsv" . validateCsv skip .
|
||||
dbg2 "parseCsv")
|
||||
`fmap` parseCsv parsecfilename csvdata
|
||||
`fmap` parseCsv parsecfilename (T.unpack csvdata)
|
||||
dbg1IO "first 3 csv records" $ take 3 records
|
||||
|
||||
-- identify header lines
|
||||
@ -607,7 +607,7 @@ transactionFromCsvRecord sourcepos rules record = t
|
||||
status =
|
||||
case mfieldtemplate "status" of
|
||||
Nothing -> Uncleared
|
||||
Just str -> either statuserror id $ runParser (statusp <* eof) mempty "" $ render str
|
||||
Just str -> either statuserror id $ runParser (statusp <* eof) mempty "" $ T.pack $ render str
|
||||
where
|
||||
statuserror err = error' $ unlines
|
||||
["error: could not parse \""++str++"\" as a cleared status (should be *, ! or empty)"
|
||||
@ -619,7 +619,7 @@ transactionFromCsvRecord sourcepos rules record = t
|
||||
precomment = maybe "" render $ mfieldtemplate "precomment"
|
||||
currency = maybe (fromMaybe "" mdefaultcurrency) render $ mfieldtemplate "currency"
|
||||
amountstr = (currency++) $ negateIfParenthesised $ getAmountStr rules record
|
||||
amount = either amounterror (Mixed . (:[])) $ runParser (amountp <* eof) mempty "" amountstr
|
||||
amount = either amounterror (Mixed . (:[])) $ runParser (amountp <* eof) mempty "" $ T.pack amountstr
|
||||
amounterror err = error' $ unlines
|
||||
["error: could not parse \""++amountstr++"\" as an amount"
|
||||
,showRecord record
|
||||
|
||||
@ -82,7 +82,7 @@ import Control.Monad
|
||||
import Control.Monad.Except (ExceptT(..), liftIO, runExceptT, throwError)
|
||||
import qualified Data.Map.Strict as M
|
||||
import Data.Monoid
|
||||
-- import Data.Text (Text)
|
||||
import Data.Text (Text)
|
||||
import qualified Data.Text as T
|
||||
import Data.Time.Calendar
|
||||
import Data.Time.LocalTime
|
||||
@ -112,14 +112,14 @@ format :: String
|
||||
format = "journal"
|
||||
|
||||
-- | Does the given file path and data look like it might be hledger's journal format ?
|
||||
detect :: FilePath -> String -> Bool
|
||||
detect f s
|
||||
detect :: FilePath -> Text -> Bool
|
||||
detect f t
|
||||
| f /= "-" = takeExtension f `elem` ['.':format, ".j"] -- from a known file name: yes if the extension is this format's name or .j
|
||||
| otherwise = regexMatches "(^|\n)[0-9]+.*\n[ \t]+" s -- from stdin: yes if we can see something that looks like a journal entry (digits in column 0 with the next line indented)
|
||||
| otherwise = regexMatches "(^|\n)[0-9]+.*\n[ \t]+" $ T.unpack t -- from stdin: yes if we can see something that looks like a journal entry (digits in column 0 with the next line indented)
|
||||
|
||||
-- | Parse and post-process a "Journal" from hledger's journal file
|
||||
-- format, or give an error.
|
||||
parse :: Maybe FilePath -> Bool -> FilePath -> String -> ExceptT String IO Journal
|
||||
parse :: Maybe FilePath -> Bool -> FilePath -> Text -> ExceptT String IO Journal
|
||||
parse _ = parseAndFinaliseJournal journalp
|
||||
|
||||
--- * parsers
|
||||
@ -190,7 +190,7 @@ includedirectivep = do
|
||||
liftIO $ runExceptT $ do
|
||||
let curdir = takeDirectory (sourceName parentpos)
|
||||
filepath <- expandPath curdir filename `orRethrowIOError` (show parentpos ++ " locating " ++ filename)
|
||||
txt <- readFile' filepath `orRethrowIOError` (show parentpos ++ " reading " ++ filepath)
|
||||
txt <- readFileAnyLineEnding filepath `orRethrowIOError` (show parentpos ++ " reading " ++ filepath)
|
||||
(ej1::Either ParseError ParsedJournal) <-
|
||||
runParserT
|
||||
(choice' [journalp
|
||||
@ -203,7 +203,7 @@ includedirectivep = do
|
||||
(throwError
|
||||
. ((show parentpos ++ " in included file " ++ show filename ++ ":\n") ++)
|
||||
. show)
|
||||
(return . journalAddFile (filepath, T.pack txt))
|
||||
(return . journalAddFile (filepath, txt))
|
||||
ej1
|
||||
case ej of
|
||||
Left e -> throwError e
|
||||
@ -311,10 +311,10 @@ aliasdirectivep = do
|
||||
alias <- accountaliasp
|
||||
addAccountAlias alias
|
||||
|
||||
accountaliasp :: Monad m => StringParser u m AccountAlias
|
||||
accountaliasp :: Monad m => TextParser u m AccountAlias
|
||||
accountaliasp = regexaliasp <|> basicaliasp
|
||||
|
||||
basicaliasp :: Monad m => StringParser u m AccountAlias
|
||||
basicaliasp :: Monad m => TextParser u m AccountAlias
|
||||
basicaliasp = do
|
||||
-- pdbg 0 "basicaliasp"
|
||||
old <- rstrip <$> many1 (noneOf "=")
|
||||
@ -323,7 +323,7 @@ basicaliasp = do
|
||||
new <- rstrip <$> anyChar `manyTill` eolof -- don't require a final newline, good for cli options
|
||||
return $ BasicAlias (T.pack old) (T.pack new)
|
||||
|
||||
regexaliasp :: Monad m => StringParser u m AccountAlias
|
||||
regexaliasp :: Monad m => TextParser u m AccountAlias
|
||||
regexaliasp = do
|
||||
-- pdbg 0 "regexaliasp"
|
||||
char '/'
|
||||
@ -433,7 +433,7 @@ transactionp = do
|
||||
code <- codep <?> "transaction code"
|
||||
description <- strip <$> descriptionp
|
||||
comment <- try followingcommentp <|> (newline >> return "")
|
||||
let tags = commentTags comment
|
||||
let tags = commentTags $ T.pack comment
|
||||
postings <- postingsp (Just date)
|
||||
n <- incrementTransactionCount
|
||||
return $ txnTieKnot $ Transaction n sourcepos date edate status code description comment tags postings ""
|
||||
|
||||
@ -57,8 +57,8 @@ import Control.Monad
|
||||
import Control.Monad.IO.Class (liftIO)
|
||||
import Control.Monad.Except (ExceptT)
|
||||
import Data.Maybe (fromMaybe)
|
||||
-- import Data.Text (Text)
|
||||
-- import qualified Data.Text as T
|
||||
import Data.Text (Text)
|
||||
import qualified Data.Text as T
|
||||
import Test.HUnit
|
||||
import Text.Parsec hiding (parse)
|
||||
import System.FilePath
|
||||
@ -76,15 +76,15 @@ format :: String
|
||||
format = "timeclock"
|
||||
|
||||
-- | Does the given file path and data look like it might be timeclock.el's timeclock format ?
|
||||
detect :: FilePath -> String -> Bool
|
||||
detect f s
|
||||
detect :: FilePath -> Text -> Bool
|
||||
detect f t
|
||||
| f /= "-" = takeExtension f == '.':format -- from a known file name: yes if the extension is this format's name
|
||||
| otherwise = regexMatches "(^|\n)[io] " s -- from stdin: yes if any line starts with "i " or "o "
|
||||
| otherwise = regexMatches "(^|\n)[io] " $ T.unpack t -- from stdin: yes if any line starts with "i " or "o "
|
||||
|
||||
-- | Parse and post-process a "Journal" from timeclock.el's timeclock
|
||||
-- format, saving the provided file path and the current time, or give an
|
||||
-- error.
|
||||
parse :: Maybe FilePath -> Bool -> FilePath -> String -> ExceptT String IO Journal
|
||||
parse :: Maybe FilePath -> Bool -> FilePath -> Text -> ExceptT String IO Journal
|
||||
parse _ = parseAndFinaliseJournal timeclockfilep
|
||||
|
||||
timeclockfilep :: ErroringJournalParser ParsedJournal
|
||||
|
||||
@ -37,6 +37,8 @@ import Control.Monad.Except (ExceptT)
|
||||
import Data.Char (isSpace)
|
||||
import Data.List (foldl')
|
||||
import Data.Maybe
|
||||
import Data.Text (Text)
|
||||
import qualified Data.Text as T
|
||||
import Test.HUnit
|
||||
import Text.Parsec hiding (parse)
|
||||
import System.FilePath
|
||||
@ -57,13 +59,13 @@ format :: String
|
||||
format = "timedot"
|
||||
|
||||
-- | Does the given file path and data look like it might contain this format ?
|
||||
detect :: FilePath -> String -> Bool
|
||||
detect f s
|
||||
detect :: FilePath -> Text -> Bool
|
||||
detect f t
|
||||
| f /= "-" = takeExtension f == '.':format -- from a file: yes if the extension matches the format name
|
||||
| otherwise = regexMatches "(^|\n)[0-9]" s -- from stdin: yes if we can see a possible timedot day entry (digits in column 0)
|
||||
| otherwise = regexMatches "(^|\n)[0-9]" $ T.unpack t -- from stdin: yes if we can see a possible timedot day entry (digits in column 0)
|
||||
|
||||
-- | Parse and post-process a "Journal" from the timedot format, or give an error.
|
||||
parse :: Maybe FilePath -> Bool -> FilePath -> String -> ExceptT String IO Journal
|
||||
parse :: Maybe FilePath -> Bool -> FilePath -> Text -> ExceptT String IO Journal
|
||||
parse _ = parseAndFinaliseJournal timedotfilep
|
||||
|
||||
timedotfilep :: ErroringJournalParser ParsedJournal
|
||||
|
||||
@ -37,6 +37,8 @@ import Control.Monad (liftM)
|
||||
-- import Data.List
|
||||
-- import Data.Maybe
|
||||
-- import Data.PPrint
|
||||
import Data.Text (Text)
|
||||
import qualified Data.Text.IO as T
|
||||
import Data.Time.Clock
|
||||
import Data.Time.LocalTime
|
||||
-- import Data.Text (Text)
|
||||
@ -134,13 +136,31 @@ firstJust ms = case dropWhile (==Nothing) ms of
|
||||
[] -> Nothing
|
||||
(md:_) -> md
|
||||
|
||||
-- | Read a file in universal newline mode, handling whatever newline convention it may contain.
|
||||
-- | Read a file in universal newline mode, handling any of the usual line ending conventions.
|
||||
readFile' :: FilePath -> IO String
|
||||
readFile' name = do
|
||||
h <- openFile name ReadMode
|
||||
hSetNewlineMode h universalNewlineMode
|
||||
hGetContents h
|
||||
|
||||
-- | Read a file in universal newline mode, handling any of the usual line ending conventions.
|
||||
readFileAnyLineEnding :: FilePath -> IO Text
|
||||
readFileAnyLineEnding path = do
|
||||
h <- openFile path ReadMode
|
||||
hSetNewlineMode h universalNewlineMode
|
||||
T.hGetContents h
|
||||
|
||||
-- | Read the given file, or standard input if the path is "-", using
|
||||
-- universal newline mode.
|
||||
readFileOrStdinAnyLineEnding :: String -> IO Text
|
||||
readFileOrStdinAnyLineEnding f = do
|
||||
h <- fileHandle f
|
||||
hSetNewlineMode h universalNewlineMode
|
||||
T.hGetContents h
|
||||
where
|
||||
fileHandle "-" = return stdin
|
||||
fileHandle f = openFile f ReadMode
|
||||
|
||||
-- | Total version of maximum, for integral types, giving 0 for an empty list.
|
||||
maximum' :: Integral a => [a] -> a
|
||||
maximum' [] = 0
|
||||
|
||||
@ -3,6 +3,8 @@ module Hledger.Utils.Parse where
|
||||
|
||||
import Data.Char
|
||||
import Data.List
|
||||
-- import Data.Text (Text)
|
||||
-- import qualified Data.Text as T
|
||||
import Text.Parsec
|
||||
import Text.Printf
|
||||
|
||||
@ -31,15 +33,15 @@ showParseError e = "parse error at " ++ show e
|
||||
showDateParseError :: ParseError -> String
|
||||
showDateParseError e = printf "date parse error (%s)" (intercalate ", " $ tail $ lines $ show e)
|
||||
|
||||
nonspace :: (Stream [Char] m Char) => ParsecT [Char] st m Char
|
||||
nonspace :: (Stream s m Char) => ParsecT s st m Char
|
||||
nonspace = satisfy (not . isSpace)
|
||||
|
||||
spacenonewline :: (Stream [Char] m Char) => ParsecT [Char] st m Char
|
||||
spacenonewline :: (Stream s m Char) => ParsecT s st m Char
|
||||
spacenonewline = satisfy (`elem` " \v\f\t")
|
||||
|
||||
restofline :: (Stream [Char] m Char) => ParsecT [Char] st m String
|
||||
restofline :: (Stream s m Char) => ParsecT s st m String
|
||||
restofline = anyChar `manyTill` newline
|
||||
|
||||
eolof :: (Stream [Char] m Char) => ParsecT [Char] st m ()
|
||||
eolof :: (Stream s m Char) => ParsecT s st m ()
|
||||
eolof = (newline >> return ()) <|> eof
|
||||
|
||||
|
||||
@ -71,17 +71,17 @@ import Hledger.Utils.String (charWidth)
|
||||
-- lowercase = map toLower
|
||||
-- uppercase = map toUpper
|
||||
|
||||
-- -- | Remove leading and trailing whitespace.
|
||||
-- strip :: String -> String
|
||||
-- strip = lstrip . rstrip
|
||||
-- | Remove leading and trailing whitespace.
|
||||
textstrip :: Text -> Text
|
||||
textstrip = textlstrip . textrstrip
|
||||
|
||||
-- -- | Remove leading whitespace.
|
||||
-- lstrip :: String -> String
|
||||
-- lstrip = dropWhile (`elem` " \t") :: String -> String -- XXX isSpace ?
|
||||
-- | Remove leading whitespace.
|
||||
textlstrip :: Text -> Text
|
||||
textlstrip = T.dropWhile (`elem` " \t") :: Text -> Text -- XXX isSpace ?
|
||||
|
||||
-- -- | Remove trailing whitespace.
|
||||
-- rstrip :: String -> String
|
||||
-- rstrip = reverse . lstrip . reverse
|
||||
-- | Remove trailing whitespace.
|
||||
textrstrip = T.reverse . textlstrip . T.reverse
|
||||
textrstrip :: Text -> Text
|
||||
|
||||
-- -- | Remove trailing newlines/carriage returns.
|
||||
-- chomp :: String -> String
|
||||
@ -94,9 +94,9 @@ import Hledger.Utils.String (charWidth)
|
||||
-- elideLeft width s =
|
||||
-- if length s > width then ".." ++ reverse (take (width - 2) $ reverse s) else s
|
||||
|
||||
-- elideRight :: Int -> String -> String
|
||||
-- elideRight width s =
|
||||
-- if length s > width then take (width - 2) s ++ ".." else s
|
||||
textElideRight :: Int -> Text -> Text
|
||||
textElideRight width t =
|
||||
if T.length t > width then T.take (width - 2) t <> ".." else t
|
||||
|
||||
-- -- | Clip and pad a string to a minimum & maximum width, and/or left/right justify it.
|
||||
-- -- Works on multi-line strings too (but will rewrite non-unix line endings).
|
||||
|
||||
@ -95,8 +95,8 @@ postAddForm = do
|
||||
| map fst acctparams == [1..num] &&
|
||||
map fst amtparams `elem` [[1..num], [1..num-1]] = []
|
||||
| otherwise = ["the posting parameters are malformed"]
|
||||
eaccts = map (parsewith (accountnamep <* eof) . strip . T.unpack . snd) acctparams
|
||||
eamts = map (runParser (amountp <* eof) mempty "" . strip . T.unpack . snd) amtparams
|
||||
eaccts = map (runParser (accountnamep <* eof) () "" . T.pack . strip . T.unpack . snd) acctparams
|
||||
eamts = map (runParser (amountp <* eof) mempty "" . T.pack . strip . T.unpack . snd) amtparams
|
||||
(accts, acctErrs) = (rights eaccts, map show $ lefts eaccts)
|
||||
(amts', amtErrs) = (rights eamts, map show $ lefts eamts)
|
||||
amts | length amts' == num = amts'
|
||||
|
||||
@ -32,6 +32,9 @@ module Hledger.Cli (
|
||||
module System.Console.CmdArgs.Explicit
|
||||
)
|
||||
where
|
||||
import Data.Monoid ((<>))
|
||||
import Data.Text (Text)
|
||||
import qualified Data.Text as T
|
||||
import Data.Time.Calendar
|
||||
import System.Console.CmdArgs.Explicit
|
||||
import Test.HUnit
|
||||
@ -80,16 +83,16 @@ tests_Hledger_Cli = TestList
|
||||
in TestList
|
||||
[
|
||||
"apply account directive 1" ~: sameParse
|
||||
("2008/12/07 One\n alpha $-1\n beta $1\n" ++
|
||||
"apply account outer\n2008/12/07 Two\n aigh $-2\n bee $2\n" ++
|
||||
"apply account inner\n2008/12/07 Three\n gamma $-3\n delta $3\n" ++
|
||||
"end apply account\n2008/12/07 Four\n why $-4\n zed $4\n" ++
|
||||
("2008/12/07 One\n alpha $-1\n beta $1\n" <>
|
||||
"apply account outer\n2008/12/07 Two\n aigh $-2\n bee $2\n" <>
|
||||
"apply account inner\n2008/12/07 Three\n gamma $-3\n delta $3\n" <>
|
||||
"end apply account\n2008/12/07 Four\n why $-4\n zed $4\n" <>
|
||||
"end apply account\n2008/12/07 Five\n foo $-5\n bar $5\n"
|
||||
)
|
||||
("2008/12/07 One\n alpha $-1\n beta $1\n" ++
|
||||
"2008/12/07 Two\n outer:aigh $-2\n outer:bee $2\n" ++
|
||||
"2008/12/07 Three\n outer:inner:gamma $-3\n outer:inner:delta $3\n" ++
|
||||
"2008/12/07 Four\n outer:why $-4\n outer:zed $4\n" ++
|
||||
("2008/12/07 One\n alpha $-1\n beta $1\n" <>
|
||||
"2008/12/07 Two\n outer:aigh $-2\n outer:bee $2\n" <>
|
||||
"2008/12/07 Three\n outer:inner:gamma $-3\n outer:inner:delta $3\n" <>
|
||||
"2008/12/07 Four\n outer:why $-4\n outer:zed $4\n" <>
|
||||
"2008/12/07 Five\n foo $-5\n bar $5\n"
|
||||
)
|
||||
|
||||
@ -124,7 +127,7 @@ tests_Hledger_Cli = TestList
|
||||
-- `is` "aa:aa:aaaaaaaaaaaaaa")
|
||||
|
||||
,"default year" ~: do
|
||||
j <- readJournal Nothing Nothing True Nothing defaultyear_journal_str >>= either error' return
|
||||
j <- readJournal Nothing Nothing True Nothing defaultyear_journal_txt >>= either error' return
|
||||
tdate (head $ jtxns j) `is` fromGregorian 2009 1 1
|
||||
return ()
|
||||
|
||||
@ -187,8 +190,8 @@ sample_journal_str = unlines
|
||||
]
|
||||
-}
|
||||
|
||||
defaultyear_journal_str :: String
|
||||
defaultyear_journal_str = unlines
|
||||
defaultyear_journal_txt :: Text
|
||||
defaultyear_journal_txt = T.unlines
|
||||
["Y2009"
|
||||
,""
|
||||
,"01/01 A"
|
||||
|
||||
@ -17,7 +17,7 @@ import Data.Char (toUpper, toLower)
|
||||
import Data.List.Compat
|
||||
import qualified Data.Set as S
|
||||
import Data.Maybe
|
||||
-- import Data.Text (Text)
|
||||
import Data.Text (Text)
|
||||
import qualified Data.Text as T
|
||||
import Data.Time.Calendar (Day)
|
||||
import Data.Typeable (Typeable)
|
||||
@ -183,7 +183,7 @@ dateAndCodeWizard EntryState{..} = do
|
||||
where
|
||||
parseSmartDateAndCode refdate s = either (const Nothing) (\(d,c) -> return (fixSmartDate refdate d, c)) edc
|
||||
where
|
||||
edc = runParser (dateandcodep <* eof) mempty "" $ lowercase s
|
||||
edc = runParser (dateandcodep <* eof) mempty "" $ T.pack $ lowercase s
|
||||
dateandcodep :: Monad m => JournalParser m (SmartDate, String)
|
||||
dateandcodep = do
|
||||
d <- smartdate
|
||||
@ -244,13 +244,18 @@ accountWizard EntryState{..} = do
|
||||
line $ green $ printf "Account %d%s%s: " pnum (endmsg::String) (showDefault def)
|
||||
where
|
||||
canfinish = not (null esPostings) && postingsBalanced esPostings
|
||||
parseAccountOrDotOrNull :: String -> Bool -> String -> Maybe String
|
||||
parseAccountOrDotOrNull _ _ "." = dbg1 $ Just "." -- . always signals end of txn
|
||||
parseAccountOrDotOrNull "" True "" = dbg1 $ Just "" -- when there's no default and txn is balanced, "" also signals end of txn
|
||||
parseAccountOrDotOrNull def@(_:_) _ "" = dbg1 $ Just def -- when there's a default, "" means use that
|
||||
parseAccountOrDotOrNull _ _ s = dbg1 $ either (const Nothing) ((T.unpack <$>) . validateAccount) $ runParser (accountnamep <* eof) esJournal "" s -- otherwise, try to parse the input as an accountname
|
||||
parseAccountOrDotOrNull _ _ s = dbg1 $ fmap T.unpack $
|
||||
either (const Nothing) validateAccount $
|
||||
runParser (accountnamep <* eof) esJournal "" (T.pack s) -- otherwise, try to parse the input as an accountname
|
||||
where
|
||||
validateAccount :: Text -> Maybe Text
|
||||
validateAccount t | no_new_accounts_ esOpts && not (t `elem` journalAccountNames esJournal) = Nothing
|
||||
| otherwise = Just t
|
||||
dbg1 = id -- strace
|
||||
validateAccount s | no_new_accounts_ esOpts && not (s `elem` journalAccountNames esJournal) = Nothing
|
||||
| otherwise = Just s
|
||||
|
||||
amountAndCommentWizard EntryState{..} = do
|
||||
let pnum = length esPostings + 1
|
||||
@ -271,8 +276,8 @@ amountAndCommentWizard EntryState{..} = do
|
||||
maybeRestartTransaction $
|
||||
line $ green $ printf "Amount %d%s: " pnum (showDefault def)
|
||||
where
|
||||
parseAmountAndComment = either (const Nothing) Just . runParser (amountandcommentp <* eof) noDefCommodityJPS ""
|
||||
noDefCommodityJPS = esJournal{jparsedefaultcommodity=Nothing}
|
||||
parseAmountAndComment = either (const Nothing) Just . runParser (amountandcommentp <* eof) nodefcommodityj "" . T.pack
|
||||
nodefcommodityj = esJournal{jparsedefaultcommodity=Nothing}
|
||||
amountandcommentp :: Monad m => JournalParser m (Amount, String)
|
||||
amountandcommentp = do
|
||||
a <- amountp
|
||||
@ -378,7 +383,7 @@ ensureOneNewlineTerminated = (++"\n") . reverse . dropWhile (=='\n') . reverse
|
||||
registerFromString :: String -> IO String
|
||||
registerFromString s = do
|
||||
d <- getCurrentDay
|
||||
j <- readJournal' s
|
||||
j <- readJournal' $ T.pack s
|
||||
return $ postingsReportAsText opts $ postingsReport ropts (queryFromOpts d ropts) j
|
||||
where
|
||||
ropts = defreportopts{empty_=True}
|
||||
|
||||
@ -1,4 +1,3 @@
|
||||
{-# LANGUAGE CPP, ScopedTypeVariables, DeriveDataTypeable, FlexibleContexts #-}
|
||||
{-|
|
||||
|
||||
Common cmdargs modes and flags, a command-line options type, and
|
||||
@ -6,6 +5,8 @@ related utilities used by hledger commands.
|
||||
|
||||
-}
|
||||
|
||||
{-# LANGUAGE CPP, ScopedTypeVariables, DeriveDataTypeable, FlexibleContexts #-}
|
||||
|
||||
module Hledger.Cli.CliOptions (
|
||||
|
||||
-- * cmdargs flags & modes
|
||||
@ -71,6 +72,8 @@ import Data.Functor.Compat ((<$>))
|
||||
import Data.List.Compat
|
||||
import Data.List.Split (splitOneOf)
|
||||
import Data.Maybe
|
||||
-- import Data.Text (Text)
|
||||
import qualified Data.Text as T
|
||||
import Safe
|
||||
import System.Console.CmdArgs
|
||||
import System.Console.CmdArgs.Explicit
|
||||
@ -384,7 +387,7 @@ getCliOpts mode' = do
|
||||
|
||||
-- | Get the account name aliases from options, if any.
|
||||
aliasesFromOpts :: CliOpts -> [AccountAlias]
|
||||
aliasesFromOpts = map (\a -> fromparse $ runParser accountaliasp () ("--alias "++quoteIfNeeded a) a)
|
||||
aliasesFromOpts = map (\a -> fromparse $ runParser accountaliasp () ("--alias "++quoteIfNeeded a) $ T.pack a)
|
||||
. alias_
|
||||
|
||||
-- | Get the (tilde-expanded, absolute) journal file path from
|
||||
|
||||
@ -1,10 +1,11 @@
|
||||
{-# LANGUAGE CPP #-}
|
||||
{-|
|
||||
|
||||
A ledger-compatible @register@ command.
|
||||
|
||||
-}
|
||||
|
||||
{-# LANGUAGE CPP, OverloadedStrings #-}
|
||||
|
||||
module Hledger.Cli.Register (
|
||||
registermode
|
||||
,register
|
||||
|
||||
Loading…
Reference in New Issue
Block a user