hledger-lib 0.11.1 → 0.12

raw patch · 10 files changed

+120/−56 lines, 10 filesdep +splitPVP ok

version bump matches the API change (PVP)

Dependencies added: split

API changes (from Hackage documentation)

Files

• Hledger/Data/Amount.hs +14/−3
• Hledger/Data/Commodity.hs +1/−1
• Hledger/Data/Dates.hs +18/−10
• Hledger/Data/TimeLog.hs +1/−1
• Hledger/Data/Types.hs +2/−4
• Hledger/Data/Utils.hs +44/−2
• Hledger/Read.hs +9/−9
• Hledger/Read/Common.hs +1/−1
• Hledger/Read/Journal.hs +24/−16
• hledger-lib.cabal +6/−9

@@ -64,9 +64,9 @@     fromInteger i = Mixed [Amount (comm "") (fromInteger i) Nothing]     negate (Mixed as) = Mixed $ map negateAmountPreservingPrice as     (+) (Mixed as) (Mixed bs) = normaliseMixedAmount $ Mixed $ as ++ bs-    (*)    = error "programming error, mixed amounts do not support multiplication"-    abs    = error "programming error, mixed amounts do not support abs"-    signum = error "programming error, mixed amounts do not support signum"+    (*)    = error' "programming error, mixed amounts do not support multiplication"+    abs    = error' "programming error, mixed amounts do not support abs"+    signum = error' "programming error, mixed amounts do not support signum"  instance Ord MixedAmount where     compare (Mixed as) (Mixed bs) = compare as bs@@ -153,6 +153,10 @@ isReallyZeroAmount = null . filter (`elem` "123456789") . printf ("%."++show zeroprecision++"f") . quantity     where zeroprecision = 8 +-- | Is this amount negative ? The price is ignored.+isNegativeAmount :: Amount -> Bool+isNegativeAmount Amount{quantity=q} = q < 0+ -- | Access a mixed amount's components. amounts :: MixedAmount -> [Amount] amounts (Mixed as) = as@@ -165,6 +169,13 @@ -- | Is this mixed amount "really" zero ? See isReallyZeroAmount. isReallyZeroMixedAmount :: MixedAmount -> Bool isReallyZeroMixedAmount = all isReallyZeroAmount . amounts . normaliseMixedAmount++-- | Is this mixed amount negative, if it can be normalised to a single commodity ?+isNegativeMixedAmount :: MixedAmount -> Maybe Bool+isNegativeMixedAmount m = case as of [a] -> Just $ isNegativeAmount a+                                     _   -> Nothing+    where+      as = amounts $ normaliseMixedAmount m  -- | Is this mixed amount "really" zero, after converting to cost -- commodities where possible ?

@@ -37,7 +37,7 @@ -- | Look up one of the hard-coded default commodities. For use in tests. comm :: String -> Commodity comm sym = fromMaybe -              (error "commodity lookup failed") +              (error' "commodity lookup failed")                $ find (\(Commodity{symbol=s}) -> s==sym) defaultcommodities  -- | Find the conversion rate between two commodities. Currently returns 1.

@@ -13,7 +13,7 @@ an open-ended span where one or both dates are unspecified. (A date span with both ends unspecified matches all dates.) -An 'Interval' is ledger's "reporting interval" - weekly, monthly,+An 'Interval' is ledger's \"reporting interval\" - weekly, monthly, quarterly, etc.  -}@@ -65,7 +65,7 @@                         : splitspan' start next (DateSpan (Just n) (Just e))           where s = start b                 n = next s-      splitspan' _ _ _ = error "won't happen, avoids warnings"+      splitspan' _ _ _ = error' "won't happen, avoids warnings"  -- | Count the days in a DateSpan, or if it is open-ended return Nothing. daysInSpan :: DateSpan -> Maybe Integer@@ -86,10 +86,16 @@           b = if isJust b1 then b1 else b2  -- | Parse a period expression to an Interval and overall DateSpan using--- the provided reference date, or raise an error.-parsePeriodExpr :: Day -> String -> (Interval, DateSpan)-parsePeriodExpr refdate expr = (interval,span)-    where (interval,span) = fromparse $ parsewith (periodexpr refdate) expr+-- the provided reference date, or return a parse error.+parsePeriodExpr :: Day -> String -> Either ParseError (Interval, DateSpan)+parsePeriodExpr refdate = parsewith (periodexpr refdate)++-- | Show a DateSpan as a human-readable pseudo-period-expression string.+dateSpanAsText :: DateSpan -> String+dateSpanAsText (DateSpan Nothing Nothing)   = "all"+dateSpanAsText (DateSpan Nothing (Just e))  = printf "to %s" (show e)+dateSpanAsText (DateSpan (Just b) Nothing)  = printf "from %s" (show b)+dateSpanAsText (DateSpan (Just b) (Just e)) = printf "%s to %s" (show b) (show e)      -- | Convert a single smart date string to a date span using the provided -- reference date, or raise an error.@@ -228,12 +234,12 @@  -- | Parse a date-time string to a time type, or raise an error. parsedatetime :: String -> LocalTime-parsedatetime s = fromMaybe (error $ "could not parse timestamp \"" ++ s ++ "\"")+parsedatetime s = fromMaybe (error' $ "could not parse timestamp \"" ++ s ++ "\"")                             (parsedatetimeM s)  -- | Parse a date string to a time type, or raise an error. parsedate :: String -> Day-parsedate s =  fromMaybe (error $ "could not parse date \"" ++ s ++ "\"")+parsedate s =  fromMaybe (error' $ "could not parse date \"" ++ s ++ "\"")                          (parsedateM s)  -- | Parse a time string to a time type using the provided pattern, or@@ -259,6 +265,7 @@ -} smartdate :: GenParser Char st 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) @@ -270,14 +277,15 @@   eof   return d -datesepchar = oneOf "/-."+datesepchars = "/-."+datesepchar = oneOf datesepchars  validYear, validMonth, validDay :: String -> Bool validYear s = length s >= 4 && isJust (readMay s :: Maybe Int) validMonth s = maybe False (\n -> n>=1 && n<=12) $ readMay s validDay s = maybe False (\n -> n>=1 && n<=31) $ readMay s --- failIfInvalidYear, failIfInvalidMonth, failIfInvalidDay :: a+failIfInvalidYear, failIfInvalidMonth, failIfInvalidDay :: (Monad m) => String -> m () 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

@@ -65,7 +65,7 @@ entryFromTimeLogInOut i o     | otime >= itime = t     | otherwise = -        error $ "clock-out time less than clock-in time in:\n" ++ showTransaction t+        error' $ "clock-out time less than clock-in time in:\n" ++ showTransaction t     where       t = Transaction {             tdate         = idate,

@@ -9,7 +9,7 @@ >   [Posting]              -- multiple account postings (entries), which have account name and amount. >  [HistoricalPrice]       -- historical commodity prices >-> Ledger                   -- a ledger is derived from a journal, by applying a filter specification. It contains..+> Ledger                   -- a ledger is derived from a journal, by applying a filter specification and doing some further processing. It contains.. >  Journal                 -- the filtered journal, containing only the transactions and postings we are interested in >  Tree AccountName        -- account names referenced in the journal's transactions, as a tree >  Map AccountName Account -- per-account postings and balances from the journal's transactions, as a  map from account name to account info@@ -26,9 +26,7 @@    - hledger 0.5: LedgerTransactions contain Postings (which are flattened to Transactions) -  - hledger 0.8: Transactions contain Postings (referencing Transactions, corecursively)--  - hledger 0.10: Postings should be called Entrys, but are left as-is for now+  - hledger 0.8: Transactions contain Postings (referencing Transactions..)  -} 

@@ -25,6 +25,7 @@ ) where import Data.Char+import Codec.Binary.UTF8.String as UTF8 (decodeString, encodeString, isUTF8Encoded) import Control.Exception import Control.Monad import Data.List@@ -44,6 +45,7 @@ import Text.Printf import Text.RegexPR import Text.ParserCombinators.Parsec+import System.Info (os)   -- strings@@ -146,6 +148,41 @@       fit w = take w . (++ repeat ' ')       blankline = replicate w ' ' +-- encoded platform strings++-- | A platform string is a string value from or for the operating system,+-- such as a file path or command-line argument (or environment variable's+-- name or value ?). On some platforms (such as unix) these are not real+-- unicode strings but have some encoding such as UTF-8. This alias does+-- no type enforcement but aids code clarity.+type PlatformString = String++-- | Convert a possibly encoded platform string to a real unicode string.+-- We decode the UTF-8 encoding recommended for unix systems+-- (cf http://www.dwheeler.com/essays/fixing-unix-linux-filenames.html)+-- and leave anything else unchanged.+fromPlatformString :: PlatformString -> String+fromPlatformString s = if UTF8.isUTF8Encoded s then UTF8.decodeString s else s++-- | Convert a unicode string to a possibly encoded platform string.+-- On unix we encode with the recommended UTF-8+-- (cf http://www.dwheeler.com/essays/fixing-unix-linux-filenames.html)+-- and elsewhere we leave it unchanged.+toPlatformString :: String -> PlatformString+toPlatformString = case os of+                     "unix" -> UTF8.encodeString+                     "linux" -> UTF8.encodeString+                     "darwin" -> UTF8.encodeString+                     _ -> id++-- | A version of error that's better at displaying unicode.+error' :: String -> a+error' = error . toPlatformString++-- | A version of userError that's better at displaying unicode.+userError' :: String -> IOError+userError' = userError . toPlatformString+ -- math  difforzero :: (Num a, Ord a) => a -> a -> a@@ -232,15 +269,20 @@ strace :: Show a => a -> a strace a = trace (show a) a --- | labelled trace - like strace, with a newline and a label prepended+-- | labelled trace - like strace, with a label prepended ltrace :: Show a => String -> a -> a ltrace l a = trace (l ++ ": " ++ show a) a +-- | monadic trace - like strace, but works as a standalone line in a monad+mtrace :: (Monad m, Show a) => a -> m a+mtrace a = strace a `seq` return a+ -- | trace an expression using a custom show function tracewith f e = trace (f e) e  -- parsing +choice' :: [GenParser tok st a] -> GenParser tok st a choice' = choice . map Text.ParserCombinators.Parsec.try  parsewith :: Parser a -> String -> Either ParseError a@@ -252,7 +294,7 @@ fromparse :: Either ParseError a -> a fromparse = either parseerror id -parseerror e = error $ showParseError e+parseerror e = error' $ showParseError e  showParseError e = "parse error at " ++ show e 

@@ -29,12 +29,12 @@ import System.Directory (doesFileExist, getHomeDirectory) import System.Environment (getEnv) import System.FilePath ((</>))-import System.IO (IOMode(..), withFile, hGetContents, stderr)+import System.IO (IOMode(..), withFile, stderr) #if __GLASGOW_HASKELL__ <= 610-import Prelude hiding (readFile, putStr, putStrLn, print, getContents)-import System.IO.UTF8+import Prelude hiding (getContents)+import System.IO.UTF8 (getContents, hGetContents) #else-import System.IO (hPutStrLn)+import System.IO (hGetContents) #endif  @@ -70,7 +70,7 @@                                 Nothing -> readers   (errors, journals) <- partitionEithers `fmap` mapM tryReader readers'   case journals of j:_ -> return $ Right j-                   _   -> let s = errMsg errors in hPutStrLn stderr s >> return (Left s)+                   _   -> return $ Left $ errMsg errors     where       tryReader r = (runErrorT . (rParser r) fp) s       errMsg [] = unknownFormatMsg@@ -104,7 +104,7 @@ emptyJournal :: IO String emptyJournal = do   d <- getCurrentDay-  return $ printf "; journal created %s; see http://hledger.org/MANUAL.html#journal-file\n\n" (show d)+  return $ printf "; journal created %s by hledger\n\n" (show d)  -- | Read a Journal from this string, using the specified data format or -- trying all known formats, or give an error string.@@ -129,11 +129,11 @@  -- | Read the user's default journal file, or give an error. myJournal :: IO Journal-myJournal = myJournalPath >>= readJournalFile Nothing >>= either error return+myJournal = myJournalPath >>= readJournalFile Nothing >>= either error' return  -- | Read the user's default timelog file, or give an error. myTimelog :: IO Journal-myTimelog = myTimelogPath >>= readJournalFile Nothing >>= either error return+myTimelog = myTimelogPath >>= readJournalFile Nothing >>= either error' return  tests_Hledger_Read = TestList   [@@ -141,7 +141,7 @@    "journalFile" ~: do     assertBool "journalFile should parse an empty file" (isRight $ parseWithCtx emptyCtx Journal.journalFile "")     jE <- readJournal Nothing "" -- don't know how to get it from journalFile-    either error (assertBool "journalFile parsing an empty file should give an empty journal" . null . jtxns) jE+    either error' (assertBool "journalFile parsing an empty file should give an empty journal" . null . jtxns) jE    ,Journal.tests_Journal   ,Timelog.tests_Timelog

@@ -36,7 +36,7 @@   tl <- liftIO getCurrentLocalTime   case runParser p emptyCtx f s of     Right updates -> liftM (journalFinalise tc tl f s) $ updates `ap` return nulljournal-    Left err      -> throwError $ show err -- XXX raises an uncaught exception if we have a parsec user error, eg from many ?+    Left err      -> throwError $ show err  -- | Some state kept while parsing a journal file. data JournalContext = Ctx {

@@ -117,11 +117,13 @@ ) where import Control.Monad.Error (ErrorT(..), throwError, catchError)+import Data.List.Split (wordsBy) import Text.ParserCombinators.Parsec hiding (parse) #if __GLASGOW_HASKELL__ <= 610 import Prelude hiding (readFile, putStr, putStrLn, print, getContents) import System.IO.UTF8 #endif+import System.FilePath import Hledger.Data.Utils import Hledger.Data.Types import Hledger.Data.Dates@@ -213,7 +215,7 @@                    outerPos <- getPosition                    let inIncluded = show outerPos ++ " in included file " ++ show filename ++ ":\n"                    return $ do contents <- expandPath outerPos filename >>= readFileE outerPos-                               case runParser journalFile outerState filename contents of+                               case runParser journalFile outerState (combine ((takeDirectory . sourceName) outerPos) filename) contents of                                  Right l   -> l `catchError` (throwError . (inIncluded ++))                                  Left perr -> throwError $ inIncluded ++ show perr     where readFileE outerPos filename = ErrorT $ liftM Right (readFile filename) `catch` leftError@@ -331,21 +333,27 @@     Left err -> fail err  ledgerdate :: GenParser Char JournalContext Day-ledgerdate = choice' [ledgerfulldate, ledgerpartialdate] <?> "full or partial date"--ledgerfulldate :: GenParser Char JournalContext Day-ledgerfulldate = do-  (y,m,d) <- ymd-  return $ fromGregorian (read y) (read m) (read d)---- | Match a partial M/D date in a ledger, and also require that a default--- year directive was previously encountered.-ledgerpartialdate :: GenParser Char JournalContext Day-ledgerpartialdate = do-  (_,m,d) <- md-  y <- getYear-  when (isNothing y) $ fail "partial date found, but no default year specified"-  return $ fromGregorian (fromJust y) (read m) (read d)+ledgerdate = do+  -- hacky: try to ensure precise errors for invalid dates+  -- XXX reported error position is not too good+  -- pos <- getPosition+  datestr <- many1 $ choice' [digit, datesepchar]+  let dateparts = wordsBy (`elem` datesepchars) datestr+  case dateparts of+    [y,m,d] -> do+               failIfInvalidYear y+               failIfInvalidMonth m+               failIfInvalidDay d+               return $ fromGregorian (read y) (read m) (read d)+    [m,d]   -> do+               y <- getYear+               case y of Nothing -> fail "partial date found, but no default year specified"+                         Just y' -> do failIfInvalidYear $ show y'+                                       failIfInvalidMonth m+                                       failIfInvalidDay d+                                       return $ fromGregorian y' (read m) (read d)+    _       -> fail $ "bad date: " ++ datestr+  <?> "full or partial date"  ledgerdatetime :: GenParser Char JournalContext LocalTime ledgerdatetime = do 

@@ -1,5 +1,5 @@ name:           hledger-lib-version: 0.11.1+version: 0.12 category:       Finance synopsis:       Core types and utilities for working with hledger (or c++ ledger) data. description:@@ -14,7 +14,7 @@ bug-reports:    http://code.google.com/p/hledger/issues stability:      experimental tested-with:    GHC==6.10-cabal-version:  >= 1.2+cabal-version:  >= 1.6 build-type:     Simple -- data-dir:        -- data-files:@@ -56,17 +56,14 @@                  ,parsec                  ,regexpr >= 0.5.1                  ,safe >= 0.2+                 ,split == 0.1.*                  ,time                  ,utf8-string >= 0.3                  ,HUnit --- source-repository head---   type:     darcs---   location: http://joyful.com/repos/hledger--- disabled for now due to:--- The 'source-repository' section is new in Cabal-1.6. Unfortunately it messes--- up the parser in earlier Cabal versions so you need to specify 'cabal-version:--- >= 1.6'.+source-repository head+  type:     darcs+  location: http://joyful.com/repos/hledger  -- cf http://www.haskell.org/cabal/release/cabal-latest/doc/users-guide/authors.html