{-# LANGUAGE DeriveDataTypeable #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE NamedFieldPuns #-}
+{-# LANGUAGE ScopedTypeVariables #-}
module Hcompta.Format.Ledger.Read where
-import Control.Applicative ((<*))
+import Control.Applicative ((<*), (<$>))
import qualified Control.Exception as Exn
-import Control.Monad
--- import Control.Monad.Error
-import Data.Data
-import Data.List
--- import Data.List.Split (wordsBy)
+import Control.Monad (guard)
+-- import Control.Monad.Error
+import qualified Data.Char
+import Data.Data
+import qualified Data.Decimal
+import qualified Data.List
+-- import Data.List.Split (wordsBy)
import qualified Data.Map
-import Data.Maybe
-import Data.Typeable ()
-import Safe (headDef, lastDef)
-import Text.Printf
-import qualified Data.Time.Clock as Time
+import Data.Maybe
import qualified Data.Time.Calendar as Time
+import qualified Data.Time.Clock as Time
import qualified Data.Time.LocalTime as Time
-import Text.Parsec hiding (parse)
+import Data.Typeable ()
+import Safe (headDef, lastDef)
+import qualified Text.Parsec as P
+import Text.Parsec (Stream, ParsecT, (<|>), (<?>))
+import Text.Printf
import qualified Hcompta.Model as Model
import qualified Hcompta.Model.Account as Account
import Hcompta.Model.Account (Account)
import qualified Hcompta.Model.Amount as Amount
-import Hcompta.Model.Amount (Amount)
+import Hcompta.Model.Amount (Amount, Conversion, Style, Unit)
+import qualified Hcompta.Model.Amount.Conversion as Conversion
+import qualified Hcompta.Model.Amount.Quantity as Quantity
+import qualified Hcompta.Model.Amount.Style as Style
+import qualified Hcompta.Model.Amount.Unit as Unit
import qualified Hcompta.Model.Date as Date
-import Hcompta.Format.Ledger.Journal as Journal
+import Hcompta.Format.Ledger.Journal as Journal
data Context
= Context
Journal.last_read_time Journal.nil
}
-
-{-
-reader :: Reader
-reader = Reader format detect parse
-
-format :: String
-format = "ledger"
-
-detect :: FilePath -> String -> Bool
-detect file s
- | file /= "-" = takeExtension file `elem` ['.':format, ".j"] -- from a file: yes if the extension is .journal or .j
- -- 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 "^[0-9]+.*\n[ \t]+" s
-
-parse :: Maybe FilePath -> Bool -> FilePath -> String -> ErrorT String IO Journal
-parse _ = parseJournal journal
-
-parseJournal
- :: ParsecT [Char] Context (ErrorT String IO) Context
- -> Bool -> FilePath -> String -> ErrorT String IO Journal
-parseJournal parser filePath fileData = do
- currentUTC <- liftIO Time.getCurrentTime
- currentTimeZone <- liftIO Time.getCurrentTimeZone
- let currentLocalTime = Time.utcToLocalTime currentTimeZone currentUTC
- let (currentLocalYear, _, _) = Time.toGregorian $ Time.localDay currentLocalTime
- parserResult <- runParserT parser
- contextNull{context_year=Just currentLocalYear}
- filePath fileData
- case parserResult of
- Left error -> throwError $ show error
- Right context -> do
- let journal = context_journal context
- journalBalanceTransactions $
- journal
- { journal_unit_styles=
- , journal_file=filePath
- , journal_includes=reverse $ journal_includes journal
- -- , journal_historical_prices=reverse $ journal_historical_prices journal
- , journal_last_read_time=currentUTC
- , journal_transactions=reverse $ journal_transactions journal
- -- , journal_transaction_modifiers=reverse $ journal_transaction_modifiers journal
- -- , journal_transaction_periodics=reverse $ journal_transaction_periodics journal
+-- * Utilities
+
+-- ** Combinators
+
+-- | Like 'Text.Parsec.choice' but with 'Text.Parsec.try' on each case.
+choice_try :: Stream s m t => [ParsecT s st m a] -> ParsecT s st m a
+choice_try = P.choice . Data.List.map P.try
+
+-- ** Numbers
+
+-- | Return the 'Integer' obtained by multiplying the given digits
+-- with the power of the given base respective to their rank.
+integer_of_digits
+ :: Integer -- ^ Base.
+ -> [Char] -- ^ Digits (MUST be recognised by 'Data.Char.digitToInt').
+ -> Integer
+integer_of_digits base =
+ Data.List.foldl (\x d ->
+ base*x + toInteger (Data.Char.digitToInt d)) 0
+
+decimal :: Stream [Char] m Char => ParsecT [Char] st m Integer
+decimal = integer 10 P.digit
+hexadecimal :: Stream [Char] m Char => ParsecT [Char] st m Integer
+hexadecimal = P.oneOf "xX" >> integer 16 P.hexDigit
+octal :: Stream [Char] m Char => ParsecT [Char] st m Integer
+octal = P.oneOf "oO" >> integer 8 P.octDigit
+
+-- | Parse an 'Integer'.
+integer :: Stream [Char] m Char
+ => Integer -> ParsecT [Char] st m Char
+ -> ParsecT [Char] st m Integer
+integer base digit = do
+ digits <- P.many1 digit
+ let n = integer_of_digits base digits
+ seq n (return n)
+
+-- | Parse either '-' into 'negate', or '+' or '' into 'id'.
+sign :: (Stream [Char] m Char, Num i) => ParsecT [Char] st m (i -> i)
+sign =
+ (P.char '-' >> return negate) <|>
+ (P.char '+' >> return id) <|>
+ return id
+
+-- ** Whites
+
+-- | Return 'True' if and only if the given 'Char' is an horizontal space.
+is_space :: Char -> Bool
+is_space c = c /= '\n' && c /= '\r' && Data.Char.isSpace c
+
+space :: Stream [Char] m Char => ParsecT [Char] st m Char
+space = P.satisfy is_space
+
+-- * Parsing 'Account'.
+
+-- | Parse an 'Account'.
+account :: Stream [Char] m Char => ParsecT [Char] st m Account
+account = do
+ P.notFollowedBy $ P.satisfy is_space
+ P.sepBy1 account_name account_separator
+
+-- | Parse an Account.'Account.Name'.
+account_name :: Stream [Char] m Char => ParsecT [Char] st m Account.Name
+account_name = do
+ P.many1 $ do
+ P.satisfy is_space
+ <* (P.lookAhead $ P.satisfy (not . Data.Char.isSpace))
+ <|> (P.notFollowedBy account_separator >> P.anyChar)
+
+account_separator :: Stream [Char] m Char => ParsecT [Char] st m Char
+account_separator = P.char ':'
+
+-- * Parsing 'Amount'.
+
+-- | Parse an 'Amount'.
+amount :: Stream [Char] m Char => ParsecT [Char] st m Amount
+amount = do
+ left_signing <- sign
+ left_unit <-
+ P.option Nothing $ do
+ u <- unit
+ s <- P.many $ P.satisfy is_space
+ return $ Just $ (u, not $ null s)
+ (quantity_, style) <- do
+ signing <- sign
+ Quantity
+ { integral
+ , fractional
+ , fractioning
+ , grouping_integral
+ , grouping_fractional
+ } <-
+ choice_try
+ [ quantity '_' ',' '_' <* (P.notFollowedBy $ P.oneOf ",._")
+ , quantity '_' '.' '_' <* (P.notFollowedBy $ P.oneOf ",._")
+ , quantity ',' '.' '_' <* (P.notFollowedBy $ P.oneOf ",._")
+ , quantity '.' ',' '_' <* (P.notFollowedBy $ P.oneOf ",._")
+ ] <?> "quantity"
+ let int = Data.List.concat integral
+ let frac_flat = Data.List.concat fractional
+ let frac = reverse $ Data.List.dropWhile (== '0') $ reverse $ frac_flat
+ let place = length frac
+ guard (place <= 255)
+ let mantissa = integer_of_digits 10 $ int ++ frac
+ return $
+ ( Data.Decimal.Decimal
+ (fromIntegral place)
+ (signing mantissa)
+ , Style.nil
+ { Style.fractioning = fractioning
+ , Style.grouping_integral = grouping_integral
+ , Style.grouping_fractional = grouping_fractional
+ , Style.precision = fromIntegral $ length frac_flat
+ }
+ )
+ (unit_, side, spaced) <-
+ case left_unit of
+ Just (u, s) ->
+ return (u, Just Style.Side_Left, Just s)
+ Nothing ->
+ P.option (Unit.nil, Nothing, Nothing) $ do
+ s <- P.many $ P.satisfy is_space
+ u <- unit
+ return $ (u, Just Style.Side_Right, Just $ not $ null s)
+ return $
+ Amount.Amount
+ { Amount.conversion = Conversion.nil -- TODO
+ , Amount.quantity = left_signing $ quantity_
+ , Amount.style = style
+ { Style.unit_side = side
+ , Style.unit_spaced = spaced
+ }
+ , Amount.unit = unit_
}
--- | Fill in any missing amounts and check that all journal transactions
--- balance, or return an error message. This is done after parsing all
--- amounts and working out the canonical commodities, since balancing
--- depends on display precision. Reports only the first error encountered.
-journalBalanceTransactions :: Journal -> Either String Journal
-journalBalanceTransactions journal =
- let transactions = journal_transactions journal
- let unit_and_style = journal_unit_styles journal
- case sequence $ map balance transactions of
- Right ts' -> Right journal{journal_transactions=map txnTieKnot ts'}
- Left e -> Left e
- where balance = balanceTransaction (Just unit_and_style)
-
--- | Convert all the journal's posting amounts (not price amounts) to
--- their canonical display settings. Ie, all amounts in a given
--- unit will use (a) the display settings of the first, and (b)
--- the greatest precision, of the posting amounts in that unit.
-journalCanonicaliseAmounts :: Journal -> Journal
-journalCanonicaliseAmounts j@Journal{journal_transactions=ts} =
- j''
- where
- j'' = j'{journal_transactions=map fixtransaction ts}
- j' = j{context_unit_and_style = canonicalStyles $ dbgAt 8 "journalAmounts" $ journalAmounts j}
- fixtransaction t@Transaction{tpostings=ps} = t{tpostings=map fixposting ps}
- fixposting p@Posting{pamount=a} = p{pamount=fixmixedamount a}
- fixmixedamount (Mixed as) = Mixed $ map fixamount as
- fixamount a@Amount{aunit=c} = a{astyle=journalCommodityStyle j' c}
-
--- | Given a list of amounts in parse order, build a map from commodities
--- to canonical display styles for amounts in that unit.
-canonicalStyles :: [Amount] -> M.Map Amount.Unit Amount.Style
-canonicalStyles amts =
- M.fromList commstyles
+data Quantity
+ = Quantity
+ { integral :: [String]
+ , fractional :: [String]
+ , fractioning :: Maybe Style.Fractioning
+ , grouping_integral :: Maybe Style.Grouping
+ , grouping_fractional :: Maybe Style.Grouping
+ }
+
+-- | Parse a 'Quantity'.
+quantity
+ :: Stream [Char] m Char
+ => Char -- ^ Integral grouping separator.
+ -> Char -- ^ Fractioning separator.
+ -> Char -- ^ Fractional grouping separator.
+ -> ParsecT [Char] st m Quantity
+quantity int_group_sep frac_sep frac_group_sep = do
+ (integral, grouping_integral) <- do
+ h <- P.many P.digit
+ case h of
+ [] -> return ([], Nothing)
+ _ -> do
+ t <- P.many $ P.char int_group_sep >> P.many1 P.digit
+ let digits = h:t
+ return (digits, grouping_of_digits int_group_sep digits)
+ (fractional, fractioning, grouping_fractional) <-
+ (case integral of
+ [] -> id
+ _ -> P.option ([], Nothing, Nothing)) $ do
+ fractioning <- P.char frac_sep
+ h <- P.many P.digit
+ t <- P.many $ P.char frac_group_sep >> P.many1 P.digit
+ let digits = h:t
+ return (digits, Just fractioning
+ , grouping_of_digits frac_group_sep $ reverse digits)
+ return $
+ Quantity
+ { integral
+ , fractional
+ , fractioning
+ , grouping_integral
+ , grouping_fractional
+ }
where
- samecomm = \a1 a2 -> aunit a1 == aunit a2
- commamts = [(aunit $ head as, as) | as <- groupBy samecomm $ sortBy (comparing aunit) amts]
- commstyles = [(c, canonicalStyleFrom $ map astyle as) | (c,as) <- commamts]
-
--- | Get all this journal's component amounts, roughly in the order parsed.
-journalAmounts :: Journal -> [Amount]
-journalAmounts =
- concatMap flatten . journalMixedAmounts
- where flatten (Mixed as) = as
-
-amountStyleFromCommodity :: Context -> Amount.Unit -> Amount.Style
-amountStyleFromCommodity context unit =
- Data.Map.findWithDefault
- (context_unit_and_style context)
- unit $
- journal_unit_styles $
- context_journal context
-
-
-
-
-setYear :: Stream [Char] m Char => Integer -> ParsecT [Char] Context m ()
-setYear y = modifyState (\ctx -> ctx{context_year=Just y})
-
-getYear :: Stream [Char] m Char => ParsecT s Context m (Maybe Integer)
-getYear = liftM context_year getState
-
-setCoA :: Stream [Char] m Char => CoA -> ParsecT [Char] Context m ()
-setCoA coa = modifyState (\ctx -> ctx{ctxCoA=coa})
-
-getCoA :: Stream [Char] m Char => ParsecT [Char] Context m CoA
-getCoA = liftM ctxCoA getState
-
-setDefaultCommodityAndStyle :: Stream [Char] m Char => (Amount.Unit,Amount.Style) -> ParsecT [Char] Context m ()
-setDefaultCommodityAndStyle cs = modifyState (\ctx -> ctx{context_unit_and_style=Just cs})
-
-getDefaultCommodityAndStyle :: Stream [Char] m Char => ParsecT [Char] Context m (Maybe (Amount.Unit,Amount.Style))
-getDefaultCommodityAndStyle = context_unit_and_style `fmap` getState
-
-pushParentAccount :: Stream [Char] m Char => String -> ParsecT [Char] Context m ()
-pushParentAccount parent = modifyState addParentAccount
- where addParentAccount ctx0 = ctx0 { context_account_prefix = parent : context_account_prefix ctx0 }
-
-popParentAccount :: Stream [Char] m Char => ParsecT [Char] Context m ()
-popParentAccount = do
- ctx0 <- getState
- case context_account_prefix ctx0 of
- [] -> unexpected "End of account block with no beginning"
- (_:rest) -> setState $ ctx0 { context_account_prefix = rest }
-
-getParentAccount :: Stream [Char] m Char => ParsecT [Char] Context m String
-getParentAccount = liftM (concatAccountNames . reverse . context_account_prefix) getState
-
-addAccountAlias :: Stream [Char] m Char => AccountAlias -> ParsecT [Char] Context m ()
-addAccountAlias a = modifyState (\(ctx@Ctx{..}) -> ctx{context_aliases=a:context_aliases})
-
-getAccountAliases :: Stream [Char] m Char => ParsecT [Char] Context m [AccountAlias]
-getAccountAliases = liftM context_aliases getState
-
-clearAccountAliases :: Stream [Char] m Char => ParsecT [Char] Context m ()
-clearAccountAliases = modifyState (\(ctx@Ctx{..}) -> ctx{context_aliases=[]})
-
--- parsers
-
-parseJournal :: ParsecT [Char] Context (ErrorT String IO) (JournalUpdate, Context)
-parseJournal = do
- journalUpdates <- many journalItem
- eof
- finalContext <- getState
- return $ (combineJournalUpdates journalUpdates, finalContext)
- where
- -- As all journal line types can be distinguished by the first
- -- character, excepting transactions versus empty (blank or
- -- comment-only) lines, can use choice w/o try
- journalItem =
- choice
- [ directive
- , liftM (return . addTransaction) parseTransaction
- , liftM (return . addModifierTransaction) parseTransactionModifier
- , liftM (return . addPeriodicTransaction) periodictransaction
- , liftM (return . addHistoricalPrice) historicalpricedirective
- , emptyorcommentlinep >> return (return id)
- , multilinecommentp >> return (return id)
- ] <?> "journal transaction or directive"
-
-parseDirective :: ParsecT [Char] Context (ErrorT String IO) JournalUpdate
-parseDirective = do
- optional $ char '!'
- choice'
- [ parseDirectiveInclude
- , parseDirectiveAlias
- , parseDirectiveEndAlias
- , parseDirectiveAccount
- , parseDirectiveEnd
- , parseDirectiveTag
- , parseDirectiveEndTag
- , parseDirectiveYear
- , parseDirectiveCommodity
- , parseDirectiveCommodityConversion
- , parseDirectiveIgnoredPriceCommodity
- ]
- <?> "directive"
-
-parseDirectiveInclude :: ParsecT [Char] Context (ErrorT String IO) JournalUpdate
-parseDirectiveInclude = do
- string "include"
- many1 spacenonewline
- filename <- restofline
- outerState <- getState
- outerPos <- getPosition
- let curdir = takeDirectory (sourceName outerPos)
- let (u::ErrorT String IO (Journal -> Journal, Context)) = do
- filepath <- expandPath curdir filename
- txt <- readFileOrError outerPos filepath
- let inIncluded = show outerPos ++ " in included file " ++ show filename ++ ":\n"
- r <- runParserT parseJournal outerState filepath txt
- case r of
- Right (ju, ctx) -> do
- u <- combineJournalUpdates [ return $ journalAddFile (filepath,txt)
- , ju
- ] `catchError` (throwError . (inIncluded ++))
- return (u, ctx)
- Left err -> throwError $ inIncluded ++ show err
- where readFileOrError pos fp =
- ErrorT $ liftM Right (readFile' fp) `Exn.catch`
- \e -> return $ Left $ printf "%s reading %s:\n%s" (show pos) fp (show (e::Exn.IOException))
- r <- liftIO $ runErrorT u
- case r of
- Left err -> return $ throwError err
- Right (ju, ctx) -> do
- setCoA (ctxCoA ctx)
- return $ ErrorT $ return $ Right ju
-
-journalAddFile :: (FilePath,String) -> Journal -> Journal
-journalAddFile f j@Journal{journal_files=fs} = j{journal_files=fs++[f]}
- -- NOTE: first encountered file to left, to avoid a reverse
-
-parseDirectiveAccount :: ParsecT [Char] Context (ErrorT String IO) JournalUpdate
-parseDirectiveAccount = do
- string "account"
- many1 spacenonewline
- parent <- parseAccountName
- newline
- pushParentAccount parent
- -- return $ return id
- return $ ErrorT $ return $ Right id
-
-parseDirectiveEnd :: ParsecT [Char] Context (ErrorT String IO) JournalUpdate
-parseDirectiveEnd = do
- string "end"
- popParentAccount
- -- return (return id)
- return $ ErrorT $ return $ Right id
-
-parseDirectiveAlias :: ParsecT [Char] Context (ErrorT String IO) JournalUpdate
-parseDirectiveAlias = do
- string "alias"
- many1 spacenonewline
- orig <- many1 $ noneOf "="
- char '='
- alias <- restofline
- addAccountAlias (accountNameWithoutPostingType $ strip orig
- ,accountNameWithoutPostingType $ strip alias)
- return $ return id
-
-parseDirectiveEndAlias :: ParsecT [Char] Context (ErrorT String IO) JournalUpdate
-parseDirectiveEndAlias = do
- string "end aliases"
- clearAccountAliases
- return (return id)
-
-parseDirectiveTag :: ParsecT [Char] Context (ErrorT String IO) JournalUpdate
-parseDirectiveTag = do
- string "tag" <?> "tag directive"
- many1 spacenonewline
- _ <- many1 nonspace
- restofline
- return $ return id
-
-parseDirectiveEndTag :: ParsecT [Char] Context (ErrorT String IO) JournalUpdate
-parseDirectiveEndTag = do
- (string "end tag" <|> string "pop") <?> "end tag or pop directive"
- restofline
- return $ return id
-
-parseDirectiveYear :: ParsecT [Char] Context (ErrorT String IO) JournalUpdate
-parseDirectiveYear = do
- char 'Y' <?> "default year"
- many spacenonewline
- y <- many1 digit
- let y' = read y
- failIfInvalidYear y
- setYear y'
- return $ return id
-
-parseDirectiveCommodity :: ParsecT [Char] Context (ErrorT String IO) JournalUpdate
-parseDirectiveCommodity = do
- char 'D' <?> "default unit"
- many1 spacenonewline
- Amount{..} <- getDefaultCommodityAndStyle >>= parseAmount
- setDefaultCommodityAndStyle (aunit, astyle)
- restofline
- return $ return id
-
-parseDirectiveHistoricalPrice :: ParsecT [Char] Context (ErrorT String IO) HistoricalPrice
-parseDirectiveHistoricalPrice = do
- char 'P' <?> "historical price"
- many spacenonewline
- date <- try (do {LocalTime d _ <- parseDateTime; return d}) <|> parseDate -- a time is ignored
- many1 spacenonewline
- symbol <- parseCommodity
- many spacenonewline
- price <- getDefaultCommodityAndStyle >>= parseAmount
- restofline
- return $ HistoricalPrice date symbol price
-
-parseDirectiveIgnoredPriceCommodity :: ParsecT [Char] Context (ErrorT String IO) JournalUpdate
-parseDirectiveIgnoredPriceCommodity = do
- char 'N' <?> "ignored-price unit"
- many1 spacenonewline
- parseCommodity
- restofline
- return $ return id
-
-parseDirectiveCommodityConversion :: ParsecT [Char] Context (ErrorT String IO) JournalUpdate
-parseDirectiveCommodityConversion = do
- char 'C' <?> "unit conversion"
- many1 spacenonewline
- default_cs <- getDefaultCommodityAndStyle
- parseAmount default_cs
- many spacenonewline
- char '='
- many spacenonewline
- parseAmount default_cs
- restofline
- return $ return id
-
-parseTransactionModifier :: ParsecT [Char] Context (ErrorT String IO) ModifierTransaction
-parseTransactionModifier = do
- char '=' <?> "modifier transaction"
- many spacenonewline
- valueexpr <- restofline
- parsePostings <- parsePostings
- return $ ModifierTransaction valueexpr parsePostings
-
-parseTransactionPeriodic :: ParsecT [Char] Context (ErrorT String IO) PeriodicTransaction
-parseTransactionPeriodic = do
- char '~' <?> "periodic transaction"
- many spacenonewline
- periodexpr <- restofline
- parsePostings <- parsePostings
- return $ PeriodicTransaction periodexpr parsePostings
-
--- | Parse a (possibly unbalanced) transaction.
-parseTransaction :: ParsecT [Char] Context (ErrorT String IO) Transaction
-parseTransaction = do
- -- ptrace "transaction"
- sourcepos <- getPosition
- date <- parseDate <?> "transaction"
- edate <- optionMaybe (parseDate2 date) <?> "secondary date"
- lookAhead (spacenonewline <|> newline) <?> "whitespace or newline"
- status <- parseStatus <?> "cleared flag"
- code <- parseCode <?> "transaction code"
- description <- descriptionp >>= return . strip
- comment <- try followingcommentp <|> (newline >> return "")
- let tags = tagsInComment comment
- parsePostings <- parsePostings
- return $ txnTieKnot $ Transaction sourcepos date edate status code description comment tags parsePostings ""
-
-descriptionp = many (noneOf ";\n")
-
--- | Parse a date in YYYY/MM/DD format. Fewer digits are allowed. The year
--- may be omitted if a default year has already been set.
-parseDate :: Stream [Char] m t => ParsecT [Char] Context m Day
-parseDate = 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 sepchars = nub $ sort $ filter (`elem` datesepchars) datestr
- when (length sepchars /= 1) $ fail $ "bad date, different separators used: " ++ datestr
- let dateparts = wordsBy (`elem` datesepchars) datestr
- currentyear <- getYear
- [y, m, d] <-
- case (dateparts,currentyear) of
- ([m,d],Just y) -> return [show y,m,d]
- ([_,_],Nothing) -> fail $ "partial date "++datestr++" found, but the current year is unknown"
- ([y,m,d],_) -> return [y,m,d]
- _ -> fail $ "bad date: " ++ datestr
- let maybedate = fromGregorianValid (read y) (read m) (read d)
- case maybedate of
- Nothing -> fail $ "bad date: " ++ datestr
- Just date -> return date
- <?> "full or partial date"
-
--- | Parse a date and time in YYYY/MM/DD HH:MM[:SS][+-ZZZZ] format. Any
--- timezone will be ignored; the time is treated as local time. Fewer
--- digits are allowed, except in the timezone. The year may be omitted if
--- a default year has already been set.
-parseDateTime :: Stream [Char] m Char => ParsecT [Char] Context m LocalTime
-parseDateTime = do
- day <- parseDate
- many1 spacenonewline
- h <- many1 digit
- let h' = read h
- guard $ h' >= 0 && h' <= 23
- char ':'
- m <- many1 digit
- let m' = read m
- guard $ m' >= 0 && m' <= 59
- s <- optionMaybe $ char ':' >> many1 digit
- let s' = case s of Just sstr -> read sstr
- Nothing -> 0
- guard $ s' >= 0 && s' <= 59
- {- tz <- -}
- optionMaybe $ do
- plusminus <- oneOf "-+"
- d1 <- digit
- d2 <- digit
- d3 <- digit
- d4 <- digit
- return $ plusminus:d1:d2:d3:d4:""
- -- ltz <- liftIO $ getCurrentTimeZone
- -- let tz' = maybe ltz (fromMaybe ltz . parseTime defaultTimeLocale "%z") tz
- -- return $ localTimeToUTC tz' $ LocalTime day $ TimeOfDay h' m' (fromIntegral s')
- return $ LocalTime day $ TimeOfDay h' m' (fromIntegral s')
-
-parseDate2 :: Stream [Char] m Char => Day -> ParsecT [Char] Context m Day
-parseDate2 primarydate = do
- char '='
- -- kludgy way to use primary date for default year
- let withDefaultYear d p = do
- y <- getYear
- let (y',_,_) = toGregorian d in setYear y'
- r <- p
- when (isJust y) $ setYear $ fromJust y
- return r
- edate <- withDefaultYear primarydate parseDate
- return edate
-
-parseStatus :: Stream [Char] m Char => ParsecT [Char] Context m Bool
-parseStatus = try (do { many spacenonewline; (char '*' <|> char '!') <?> "status"; return True } ) <|> return False
-
-parseCode :: Stream [Char] m Char => ParsecT [Char] Context m String
-parseCode = try (do { many1 spacenonewline; char '(' <?> "parseCode"; code <- anyChar `manyTill` char ')'; return code } ) <|> return ""
-
--- Parse the following whitespace-beginning lines as parsePostings, posting tags, and/or comments.
-parsePostings :: Stream [Char] m Char => ParsecT [Char] Context m [Posting]
-parsePostings = many1 (try parsePosting) <?> "parsePostings"
-
-parsePosting :: Stream [Char] m Char => ParsecT [Char] Context m Posting
-parsePosting = do
- many1 spacenonewline
- status <- parseStatus
- many spacenonewline
- account <- modifiedaccountname
- let (ptype, account') = (accountNamePostingType account, unbracket account)
- amount <- spaceandamountormissing
- massertion <- partialbalanceassertion
- _ <- fixedlotprice
- many spacenonewline
- ctx <- getState
- comment <- try followingcommentp <|> (newline >> return "")
- let tags = tagsInComment comment
- coa <- getCoA
- pcoa <-
- if isZeroMixedAmount amount
- then do
- let coa_ = coaAdd coa (accountNameComponents account) tags
- setCoA coa_
- return coa_
- else return coa
- date <-
- case dateValueFromTags tags of
- Nothing -> return Nothing
- Just v ->
- case runParser (parseDate <* eof) ctx "" v of
- Right d -> return $ Just d
- Left err -> parserFail $ show err
- date2 <-
- case date2ValueFromTags tags of
- Nothing -> return Nothing
- Just v ->
- case runParser (parseDate <* eof) ctx "" v of
- Right d -> return $ Just d
- Left err -> parserFail $ show err
- return posting
- { Posting.date=date
- , Posting.date2=date2
- , Posting.status=status
- , Posting.account=account'
- , Posting.amount=amount
- , Posting.comment=comment
- , Posting.type=ptype
- , Posting.tags=tags
- , Posting.coa=pcoa
- , Posting.balanceassertion=massertion
- }
-
-
--- | Parse an account name, then apply any parent account prefix and/or account aliases currently in effect.
-modifiedaccountname :: Stream [Char] m Char => ParsecT [Char] Context m AccountName
-modifiedaccountname = do
- a <- parseAccountName
- prefix <- getParentAccount
- let prefixed = prefix `joinAccountNames` a
- aliases <- getAccountAliases
- return $ accountNameApplyAliases aliases prefixed
-
--- accountnamechar = notFollowedBy (oneOf "()[]") >> nonspace
--- <?> "account name character (non-bracket, non-parenthesis, non-whitespace)"
-
--- | Parse whitespace then an amount, with an optional left or right
--- currency symbol and optional price, or return the special
--- "missing" marker amount.
-spaceandamountormissing :: Stream [Char] m Char => ParsecT [Char] Context m MixedAmount
-spaceandamountormissing = do
- default_cs <- getDefaultCommodityAndStyle
- try (do
- many1 spacenonewline
- (Mixed . (:[])) `fmap` parseAmount default_cs <|> return missingmixedamt
- ) <|> return missingmixedamt
-
-partialbalanceassertion :: Stream [Char] m t => ParsecT [Char] Context m (Maybe MixedAmount)
-partialbalanceassertion = do
- default_cs <- getDefaultCommodityAndStyle
- try (do
- many spacenonewline
- char '='
- many spacenonewline
- a <- parseAmount default_cs -- XXX should restrict to a simple amount
- return $ Just $ Mixed [a])
- <|> return Nothing
-
--- balanceassertion :: Stream [Char] m Char => ParsecT [Char] Context m (Maybe MixedAmount)
--- balanceassertion =
--- default_cs <- getDefaultCommodityAndStyle
--- try (do
--- many spacenonewline
--- string "=="
--- many spacenonewline
--- a <- parseAmount default_cs -- XXX should restrict to a simple amount
--- return $ Just $ Mixed [a])
--- <|> return Nothing
-
--- http://ledger-cli.org/3.0/doc/ledger3.html#Fixing-Lot-Prices
-fixedlotprice :: Stream [Char] m Char => ParsecT [Char] Context m (Maybe Amount)
-fixedlotprice = do
- default_cs <- getDefaultCommodityAndStyle
- try (do
- many spacenonewline
- char '{'
- many spacenonewline
- char '='
- many spacenonewline
- a <- parseAmount default_cs -- XXX should restrict to a simple amount
- many spacenonewline
- char '}'
- return $ Just a)
- <|> return Nothing
-
--- comment parsers
-
-multilinecommentp :: Stream [Char] m Char => ParsecT [Char] Context m ()
-multilinecommentp = do
- string "comment" >> newline
- go
- where
- go = try (string "end comment" >> newline >> return ())
- <|> (anyLine >> go)
- anyLine = anyChar `manyTill` newline
-
-emptyorcommentlinep :: Stream [Char] m Char => ParsecT [Char] Context m ()
-emptyorcommentlinep = do
- many spacenonewline >> (parseComment <|> (many spacenonewline >> newline >> return ""))
- return ()
-
-followingcommentp :: Stream [Char] m Char => ParsecT [Char] Context m String
-followingcommentp =
- -- ptrace "followingcommentp"
- do samelinecomment <- many spacenonewline >> (try semicoloncomment <|> (newline >> return ""))
- newlinecomments <- many (try (many1 spacenonewline >> semicoloncomment))
- return $ unlines $ samelinecomment:newlinecomments
-
-parseComment :: Stream [Char] m Char => ParsecT [Char] Context m String
-parseComment = commentStartingWith commentchars
-
-commentchars :: [Char]
-commentchars = "#;*"
-
-semicoloncomment :: Stream [Char] m Char => ParsecT [Char] Context m String
-semicoloncomment = commentStartingWith ";"
-
-commentStartingWith :: Stream [Char] m Char => String -> ParsecT [Char] Context m String
-commentStartingWith cs = do
- -- ptrace "commentStartingWith"
- oneOf cs
- many spacenonewline
- l <- anyChar `manyTill` eolof
- optional newline
- return l
-
-tagsInComment :: String -> [Tag]
-tagsInComment c = concatMap tagsInCommentLine $ lines c'
- where
- c' = ledgerDateSyntaxToTags c
-
-tagsInCommentLine :: String -> [Tag]
-tagsInCommentLine = catMaybes . map maybetag . map strip . splitAtElement ','
- where
- maybetag s = case runParser (parseTag <* eof) contextNull "" s of
- Right t -> Just t
- Left _ -> Nothing
-
-parseTag = do
- -- ptrace "parseTag"
- n <- parseTagName
- v <- parseTagValue
- return (n,v)
-
-parseTagName = do
- -- ptrace "parseTagName"
- n <- many1 $ noneOf ": \t"
- char ':'
- return n
-
-parseTagValue = do
- -- ptrace "parseTagValue"
- v <- anyChar `manyTill` ((char ',' >> return ()) <|> eolof)
- return $ strip $ reverse $ dropWhile (==',') $ reverse $ strip v
-
-ledgerDateSyntaxToTags :: String -> String
-ledgerDateSyntaxToTags =
- regexReplaceBy "\\[[-.\\/0-9=]+\\]" replace
+ grouping_of_digits :: Char -> [String] -> Maybe Style.Grouping
+ grouping_of_digits group_sep digits =
+ case digits of
+ [] -> Nothing
+ [_] -> Nothing
+ _ -> Just $
+ Style.Grouping group_sep $
+ canonicalize_grouping $
+ map length $ digits
+ canonicalize_grouping :: [Int] -> [Int]
+ canonicalize_grouping groups =
+ Data.List.foldl -- NOTE: remove duplicates at begining and reverse.
+ (\acc l0 -> case acc of
+ l1:_ -> if l0 == l1 then acc else l0:acc
+ _ -> l0:acc) [] $
+ case groups of -- NOTE: keep only longer at begining.
+ l0:l1:t -> if l0 > l1 then groups else l1:t
+ _ -> groups
+
+-- | Parse an 'Unit'.
+unit :: Stream [Char] m Char => ParsecT [Char] st m Unit
+unit =
+ (quoted <|> unquoted) <?> "unit"
where
- replace ('[':s) | lastDef ' ' s == ']' = replace' $ init s
- replace s = s
-
- replace' s | isdate s = datetag s
- replace' ('=':s) | isdate s = date2tag s
- replace' s | last s =='=' && isdate (init s) = datetag (init s)
- replace' s | length ds == 2 && isdate d1 && isdate d1 = datetag d1 ++ date2tag d2
- where
- ds = splitAtElement '=' s
- d1 = headDef "" ds
- d2 = lastDef "" ds
- replace' s = s
-
- isdate = isJust . parsedateM
- datetag s = "date:"++s++", "
- date2tag s = "date2:"++s++", "
-
-dateValueFromTags, date2ValueFromTags :: [Tag] -> Maybe String
-dateValueFromTags ts = maybe Nothing (Just . snd) $ find ((=="date") . fst) ts
-date2ValueFromTags ts = maybe Nothing (Just . snd) $ find ((=="date2") . fst) ts
--}
+ unquoted :: Stream [Char] m Char => ParsecT [Char] st m Unit
+ unquoted =
+ P.many1 $
+ P.satisfy $ \c ->
+ case Data.Char.generalCategory c of
+ Data.Char.CurrencySymbol -> True
+ Data.Char.LowercaseLetter -> True
+ Data.Char.ModifierLetter -> True
+ Data.Char.OtherLetter -> True
+ Data.Char.TitlecaseLetter -> True
+ Data.Char.UppercaseLetter -> True
+ _ -> False
+ quoted :: Stream [Char] m Char => ParsecT [Char] st m Unit
+ quoted =
+ P.between (P.char '"') (P.char '"') $
+ P.many1 $
+ P.noneOf ";\n\""
nil :: Account
nil = []
+-- | Return the given 'Account' without its last 'Name' is any.
+ascending :: Account -> Account
+ascending [] = []
+ascending [a] = []
+ascending (n:a) = n:ascending a
+
-- | Apply the given function to all the prefixes of the given 'Account'.
fold :: Account -> (Account -> a -> a) -> a -> a
fold = loop []
loop path (name:account) f acc =
let next = path++[name] in
loop next account f (f next acc)
-
-
--- | Return the given 'Account' without its last 'Name'.
-chomp :: Account -> Account
-chomp [] = []
-chomp [a] = []
-chomp (n:a) = n:chomp a
then (style a, unit a)
else error "(*) by non-scalar unit"
---- ** Constructors
+-- ** Constructors
nil :: Amount
nil =
, unit = ""
}
---- *** From 'Quantity'
+-- *** From 'Quantity'
--- | Return an empty 'Unit' 'Amount'.
+-- | Return an 'Amount' with 'unit' = Unit.'Unit.nil'.
scalar :: Quantity -> Amount
scalar q =
Amount
- { conversion=Nothing
- , quantity=q
- , style=Style.Style
- { Style.decimal_point=Just '.'
- , Style.format=Just $ Style.Format ',' [3]
- , Style.precision=maxBound
- , Style.unit_side=Just Style.Side_Right
- , Style.unit_spaced=Just False
+ { conversion = Nothing
+ , quantity = q
+ , style = Style.Style
+ { Style.fractioning = Just '.'
+ , Style.grouping_fractional = Just $ Style.Grouping ',' [3]
+ , Style.grouping_integral = Just $ Style.Grouping ',' [3]
+ , Style.precision = maxBound
+ , Style.unit_side = Just Style.Side_Right
+ , Style.unit_spaced = Just False
}
- , unit=""
+ , unit = ""
}
-- | <https://en.wikipedia.org/wiki/Swiss_franc Swiss franc> unit of currency.
chf :: Quantity -> Amount
chf q =
Amount
- { conversion=Nothing
- , quantity=q
- , style=Style.Style
- { Style.decimal_point=Just ','
- , Style.format=Just $ Style.Format '.' [3]
- , Style.precision=2
- , Style.unit_side=Just Style.Side_Right
- , Style.unit_spaced=Just False
+ { conversion = Nothing
+ , quantity = q
+ , style = Style.Style
+ { Style.fractioning = Just ','
+ , Style.grouping_fractional = Just $ Style.Grouping '.' [3]
+ , Style.grouping_integral = Just $ Style.Grouping '.' [3]
+ , Style.precision = 2
+ , Style.unit_side = Just Style.Side_Right
+ , Style.unit_spaced = Just False
}
- , unit="CHF"
+ , unit = "CHF"
}
-- | <https://en.wikipedia.org/wiki/Yuan Yuan> unit of currency.
cny :: Quantity -> Amount
cny q =
Amount
- { conversion=Nothing
- , quantity=q
- , style=Style.Style
- { Style.decimal_point=Just ','
- , Style.format=Just $ Style.Format '.' [3]
- , Style.precision=2
- , Style.unit_side=Just Style.Side_Right
- , Style.unit_spaced=Just False
+ { conversion = Nothing
+ , quantity = q
+ , style = Style.Style
+ { Style.fractioning = Just ','
+ , Style.grouping_fractional = Just $ Style.Grouping '.' [3]
+ , Style.grouping_integral = Just $ Style.Grouping '.' [3]
+ , Style.precision = 2
+ , Style.unit_side = Just Style.Side_Right
+ , Style.unit_spaced = Just False
}
- , unit="Ұ"
+ , unit = "Ұ"
}
-- | <https://en.wikipedia.org/wiki/Euro Euro> unit of currency.
eur :: Quantity -> Amount
eur q =
Amount
- { conversion=Nothing
- , quantity=q
- , style=Style.Style
- { Style.decimal_point=Just ','
- , Style.format=Just $ Style.Format '.' [3]
- , Style.precision=2
- , Style.unit_side=Just Style.Side_Right
- , Style.unit_spaced=Just False
+ { conversion = Nothing
+ , quantity = q
+ , style = Style.Style
+ { Style.fractioning = Just ','
+ , Style.grouping_fractional = Just $ Style.Grouping '.' [3]
+ , Style.grouping_integral = Just $ Style.Grouping '.' [3]
+ , Style.precision = 2
+ , Style.unit_side = Just Style.Side_Right
+ , Style.unit_spaced = Just False
}
- , unit="€"
+ , unit = "€"
}
-- | <https://en.wikipedia.org/wiki/Pound_sterling Pound sterling> unit of currency.
gbp :: Quantity -> Amount
gbp q =
Amount
- { conversion=Nothing
- , quantity=q
- , style=Style.Style
- { Style.decimal_point=Just '.'
- , Style.format=Just $ Style.Format ',' [3]
- , Style.precision=2
- , Style.unit_side=Just Style.Side_Left
- , Style.unit_spaced=Just False
+ { conversion = Nothing
+ , quantity = q
+ , style = Style.Style
+ { Style.fractioning = Just '.'
+ , Style.grouping_fractional = Just $ Style.Grouping ',' [3]
+ , Style.grouping_integral = Just $ Style.Grouping ',' [3]
+ , Style.precision = 2
+ , Style.unit_side = Just Style.Side_Left
+ , Style.unit_spaced = Just False
}
- , unit="£"
+ , unit = "£"
}
-- | <https://en.wikipedia.org/wiki/Indian_rupee Indian rupee> unit of currency.
inr :: Quantity -> Amount
inr q =
Amount
- { conversion=Nothing
- , quantity=q
- , style=Style.Style
- { Style.decimal_point=Just ','
- , Style.format=Just $ Style.Format '.' [3]
- , Style.precision=2
- , Style.unit_side=Just Style.Side_Right
- , Style.unit_spaced=Just False
+ { conversion = Nothing
+ , quantity = q
+ , style = Style.Style
+ { Style.fractioning = Just ','
+ , Style.grouping_fractional = Just $ Style.Grouping '.' [3]
+ , Style.grouping_integral = Just $ Style.Grouping '.' [3]
+ , Style.precision = 2
+ , Style.unit_side = Just Style.Side_Right
+ , Style.unit_spaced = Just False
}
- , unit="₹"
+ , unit = "₹"
}
-- | <https://en.wikipedia.org/wiki/Japanese_yen Japanese yen> unit of currency.
jpy :: Quantity -> Amount
jpy q =
Amount
- { conversion=Nothing
- , quantity=q
- , style=Style.Style
- { Style.decimal_point=Just '.'
- , Style.format=Just $ Style.Format ',' [3]
- , Style.precision=2
- , Style.unit_side=Just Style.Side_Left
- , Style.unit_spaced=Just False
+ { conversion = Nothing
+ , quantity = q
+ , style = Style.Style
+ { Style.fractioning = Just '.'
+ , Style.grouping_fractional = Just $ Style.Grouping ',' [3]
+ , Style.grouping_integral = Just $ Style.Grouping ',' [3]
+ , Style.precision = 2
+ , Style.unit_side = Just Style.Side_Left
+ , Style.unit_spaced = Just False
}
- , unit="¥"
+ , unit = "¥"
}
-- | <https://en.wikipedia.org/wiki/Russian_ruble Russian ruble> unit of currency.
--
rub :: Quantity -> Amount
rub q =
Amount
- { conversion=Nothing
- , quantity=q
- , style=Style.Style
- { Style.decimal_point=Just '.'
- , Style.format=Just $ Style.Format ',' [3]
- , Style.precision=2
- , Style.unit_side=Just Style.Side_Left
- , Style.unit_spaced=Just False
+ { conversion = Nothing
+ , quantity = q
+ , style = Style.Style
+ { Style.fractioning = Just '.'
+ , Style.grouping_fractional = Just $ Style.Grouping ',' [3]
+ , Style.grouping_integral = Just $ Style.Grouping ',' [3]
+ , Style.precision = 2
+ , Style.unit_side = Just Style.Side_Left
+ , Style.unit_spaced = Just False
}
- , unit="Ꝑ"
+ , unit = "Ꝑ"
}
-- | <https://en.wikipedia.org/wiki/United_States_dollar United States dollar> unit of currency.
usd :: Quantity -> Amount
usd q =
Amount
- { conversion=Nothing
- , quantity=q
- , style=Style.Style
- { Style.decimal_point=Just '.'
- , Style.format=Just $ Style.Format ',' [3]
- , Style.precision=2
- , Style.unit_side=Just Style.Side_Left
- , Style.unit_spaced=Just False
+ { conversion = Nothing
+ , quantity = q
+ , style = Style.Style
+ { Style.fractioning = Just '.'
+ , Style.grouping_fractional = Just $ Style.Grouping ',' [3]
+ , Style.grouping_integral = Just $ Style.Grouping ',' [3]
+ , Style.precision = 2
+ , Style.unit_side = Just Style.Side_Left
+ , Style.unit_spaced = Just False
}
- , unit="$"
+ , unit = "$"
}
---- ** Tests
+-- ** Tests
-- | Return 'True' if and only if 'Amount'’s 'Quantity' is zero at 'Style'’s precision.
is_zero :: Amount -> Bool
-- * The 'By_Unit' mapping
--- | 'By_Unit'’s is a partially valid 'Num' instance:
---
--- * (*) operator is not defined.
type By_Unit
= Data.Map.Map Unit Amount
--- XXX: haddock drops this instance
-- | 'By_Unit'’s is a partially valid 'Num' instance.
+--
+-- * (*) operator is not defined.
instance Num By_Unit where
abs = Data.Map.map (\a@Amount{quantity=q} -> a{quantity=abs q})
fromInteger = Data.Map.singleton "" . fromInteger
, date :: Date
} deriving (Data, Eq, Read, Show, Typeable)
+nil :: Maybe Conversion
+nil = Nothing
data Style
= Style
- { decimal_point :: Maybe Char
- , format :: Maybe Format
- , precision :: Word8
+ { fractioning :: Maybe Fractioning
+ , grouping_integral :: Maybe Grouping
+ , grouping_fractional :: Maybe Grouping
+ , precision :: Precision
, unit_side :: Maybe Side
- , unit_spaced :: Maybe Bool
+ , unit_spaced :: Maybe Spacing
} deriving (Data, Eq, Ord, Read, Show, Typeable)
+type Fractioning
+ = Char
+
+data Grouping
+ = Grouping Char [Int]
+ deriving (Data, Eq, Ord, Read, Show, Typeable)
+
+type Precision
+ = Word8
+
+type Spacing
+ = Bool
+
data Side
= Side_Left
| Side_Right
deriving (Data, Eq, Ord, Read, Show, Typeable)
-data Format
- = Format Char [Int]
- deriving (Data, Eq, Ord, Read, Show, Typeable)
-
-- * Constructors
nil :: Style
nil =
Style
- { decimal_point = Nothing
- , format = Nothing
+ { fractioning = Nothing
+ , grouping_integral = Nothing
+ , grouping_fractional = Nothing
, precision = 0
, unit_side = Nothing
, unit_spaced = Nothing
union :: Style -> Style -> Style
union
style@Style
- { decimal_point=decimal_point_
- , format=format_
+ { fractioning=fractioning_
+ , grouping_integral=grouping_integral_
+ , grouping_fractional=grouping_fractional_
, precision=precision_
, unit_side=side
, unit_spaced=spaced
}
style'@Style
- { decimal_point=decimal_point'
- , format=format_'
+ { fractioning=fractioning'
+ , grouping_integral=grouping_integral_'
+ , grouping_fractional=grouping_fractional_'
, precision=precision'
, unit_side=side'
, unit_spaced=spaced'
then style'
else
Style
- { decimal_point=maybe decimal_point' (const decimal_point_) decimal_point_
- , format=maybe format_' (const format_) format_
+ { fractioning=maybe fractioning' (const fractioning_) fractioning_
+ , grouping_integral=maybe grouping_integral_' (const grouping_integral_) grouping_integral_
+ , grouping_fractional=maybe grouping_fractional_' (const grouping_fractional_) grouping_fractional_
, precision=max precision_ precision'
, unit_side=maybe side' (const side) side
, unit_spaced=maybe spaced' (const spaced) spaced
type Unit
= String
+
+nil :: Unit
+nil = ""
, date = Date.nil
, date2 = Nothing
, status = False
+ , sourcepos = initialPos ""
, tags = Data.Map.empty
, type_ = Type_Regular
}
import Test.Framework.Providers.HUnit (hUnitTestToTests)
import Test.Framework.Runners.Console (defaultMain)
+import Control.Applicative ((<*))
import qualified Data.List
import qualified Data.Map
+import qualified Data.Either
+import qualified Text.Parsec
+import qualified Data.Decimal
+import Data.Decimal (Decimal(..))
import qualified Hcompta.Model as Model
import qualified Hcompta.Model.Account as Account
import qualified Hcompta.Model.Amount as Amount
import qualified Hcompta.Model.Amount.Quantity as Quantity
+import qualified Hcompta.Model.Amount.Style as Style
import qualified Hcompta.Model.Transaction as Transaction
+import Hcompta.Model.Transaction (Posting)
import qualified Hcompta.Model.Transaction.Posting as Posting
-import Hcompta.Model.Transaction.Posting (Posting)
import qualified Hcompta.Calc as Calc
import qualified Hcompta.Calc.Balance as Calc.Balance
+import qualified Hcompta.Format.Ledger as Format.Ledger
+import qualified Hcompta.Format.Ledger.Read as Format.Ledger.Read
main :: IO ()
main = defaultMain $ hUnitTestToTests test_Hcompta
, "[A, B, C] = [[A], [A, B], [A, B, C]]" ~:
(reverse $ Account.fold ["A", "B", "C"] (:) []) ~?= [["A"], ["A", "B"], ["A", "B", "C"]]
]
- , "chomp" ~: TestList
+ , "ascending" ~: TestList
[ "[] = []" ~:
- Account.chomp [] ~?= []
+ Account.ascending [] ~?= []
, "[A] = []" ~:
- Account.chomp ["A"] ~?= []
+ Account.ascending ["A"] ~?= []
, "[A, B] = [A]" ~:
- Account.chomp ["A", "B"] ~?= ["A"]
+ Account.ascending ["A", "B"] ~?= ["A"]
, "[A, B, C] = [A, B]" ~:
- Account.chomp ["A", "B", "C"] ~?= ["A", "B"]
+ Account.ascending ["A", "B", "C"] ~?= ["A", "B"]
]
]
]
Data.Map.fromList
[ (["A"], Amount.from_List [ Amount.usd $ 2 ])
, (["A", "B"], Amount.from_List [ Amount.usd $ 1 ]) ])
+ , "A+$1 A/B+$1 A/B/C+$1 = A+$3 A/B+$2 A/B/C+$1" ~:
+ Calc.Balance.expand
+ (Data.Map.fromList
+ [ (["A"], Amount.from_List [ Amount.usd $ 1 ])
+ , (["A", "B"], Amount.from_List [ Amount.usd $ 1 ])
+ , (["A", "B", "C"], Amount.from_List [ Amount.usd $ 1 ])
+ ])
+ ~?=
+ (Calc.Balance.Expanded $
+ Data.Map.fromList
+ [ (["A"], Amount.from_List [ Amount.usd $ 3 ])
+ , (["A", "B"], Amount.from_List [ Amount.usd $ 2 ])
+ , (["A", "B", "C"], Amount.from_List [ Amount.usd $ 1 ])
+ ])
+ , "A+$1 A/B+$1 A/B/C+$1 A/B/C/D+$1 = A+$4 A/B+$3 A/B/C+$2 A/B/C/D+$1" ~:
+ Calc.Balance.expand
+ (Data.Map.fromList
+ [ (["A"], Amount.from_List [ Amount.usd $ 1 ])
+ , (["A", "B"], Amount.from_List [ Amount.usd $ 1 ])
+ , (["A", "B", "C"], Amount.from_List [ Amount.usd $ 1 ])
+ , (["A", "B", "C", "D"], Amount.from_List [ Amount.usd $ 1 ])
+ ])
+ ~?=
+ (Calc.Balance.Expanded $
+ Data.Map.fromList
+ [ (["A"], Amount.from_List [ Amount.usd $ 4 ])
+ , (["A", "B"], Amount.from_List [ Amount.usd $ 3 ])
+ , (["A", "B", "C"], Amount.from_List [ Amount.usd $ 2 ])
+ , (["A", "B", "C", "D"], Amount.from_List [ Amount.usd $ 1 ])
+ ])
, "A+$1 A/B+$1 B/A+$1 = A+$2 A/B+$1 B/A+$1" ~:
Calc.Balance.expand
(Data.Map.fromList
]
]
]
+ , "Format" ~: TestList
+ [ "Ledger" ~: TestList
+ [ "Read" ~: TestList
+ [ "account_name" ~: TestList
+ [ "\"\" = Left" ~:
+ (Data.Either.rights $
+ [Text.Parsec.runParser
+ (Format.Ledger.Read.account_name <* Text.Parsec.eof)
+ () "" ""])
+ ~?=
+ []
+ , "\"A\" = Right \"A\"" ~:
+ (Data.Either.rights $
+ [Text.Parsec.runParser
+ (Format.Ledger.Read.account_name <* Text.Parsec.eof)
+ () "" "A"])
+ ~?=
+ ["A"]
+ , "\"AA\" = Right \"AA\"" ~:
+ (Data.Either.rights $
+ [Text.Parsec.runParser
+ (Format.Ledger.Read.account_name <* Text.Parsec.eof)
+ () "" "AA"])
+ ~?=
+ ["AA"]
+ , "\" \" = Left" ~:
+ (Data.Either.rights $
+ [Text.Parsec.runParser
+ (Format.Ledger.Read.account_name <* Text.Parsec.eof)
+ () "" " "])
+ ~?=
+ []
+ , "\":\" = Left" ~:
+ (Data.Either.rights $
+ [Text.Parsec.runParser
+ (Format.Ledger.Read.account_name <* Text.Parsec.eof)
+ () "" ":"])
+ ~?=
+ []
+ , "\"A:\" = Left" ~:
+ (Data.Either.rights $
+ [Text.Parsec.runParser
+ (Format.Ledger.Read.account_name <* Text.Parsec.eof)
+ () "" "A:"])
+ ~?=
+ []
+ , "\":A\" = Left" ~:
+ (Data.Either.rights $
+ [Text.Parsec.runParser
+ (Format.Ledger.Read.account_name <* Text.Parsec.eof)
+ () "" ":A"])
+ ~?=
+ []
+ , "\"A \" = Left" ~:
+ (Data.Either.rights $
+ [Text.Parsec.runParser
+ (Format.Ledger.Read.account_name <* Text.Parsec.eof)
+ () "" "A "])
+ ~?=
+ []
+ , "\"A A\" = Right \"A A\"" ~:
+ (Data.Either.rights $
+ [Text.Parsec.runParser
+ (Format.Ledger.Read.account_name <* Text.Parsec.eof)
+ () "" "A A"])
+ ~?=
+ ["A A"]
+ , "\"A \" = Left" ~:
+ (Data.Either.rights $
+ [Text.Parsec.runParser
+ (Format.Ledger.Read.account_name <* Text.Parsec.eof)
+ () "" "A "])
+ ~?=
+ []
+ , "\"A \\n\" = Left" ~:
+ (Data.Either.rights $
+ [Text.Parsec.runParser
+ (Format.Ledger.Read.account_name <* Text.Parsec.eof)
+ () "" "A \n"])
+ ~?=
+ []
+ ]
+ , "account" ~: TestList
+ [ "\"\" = Left" ~:
+ (Data.Either.rights $
+ [Text.Parsec.runParser
+ (Format.Ledger.Read.account <* Text.Parsec.eof)
+ () "" ""])
+ ~?=
+ []
+ , "\"A\" = Right [\"A\"]" ~:
+ (Data.Either.rights $
+ [Text.Parsec.runParser
+ (Format.Ledger.Read.account <* Text.Parsec.eof)
+ () "" "A"])
+ ~?=
+ [["A"]]
+ , "\"A:\" = Left" ~:
+ (Data.Either.rights $
+ [Text.Parsec.runParser
+ (Format.Ledger.Read.account <* Text.Parsec.eof)
+ () "" "A:"])
+ ~?=
+ []
+ , "\":A\" = Left" ~:
+ (Data.Either.rights $
+ [Text.Parsec.runParser
+ (Format.Ledger.Read.account <* Text.Parsec.eof)
+ () "" ":A"])
+ ~?=
+ []
+ , "\"A \" = Left" ~:
+ (Data.Either.rights $
+ [Text.Parsec.runParser
+ (Format.Ledger.Read.account <* Text.Parsec.eof)
+ () "" "A "])
+ ~?=
+ []
+ , "\" A\" = Left" ~:
+ (Data.Either.rights $
+ [Text.Parsec.runParser
+ (Format.Ledger.Read.account <* Text.Parsec.eof)
+ () "" " A"])
+ ~?=
+ []
+ , "\"A:B\" = Right [\"A\", \"B\"]" ~:
+ (Data.Either.rights $
+ [Text.Parsec.runParser
+ (Format.Ledger.Read.account <* Text.Parsec.eof)
+ () "" "A:B"])
+ ~?=
+ [["A", "B"]]
+ , "\"A:B:C\" = Right [\"A\", \"B\", \"C\"]" ~:
+ (Data.Either.rights $
+ [Text.Parsec.runParser
+ (Format.Ledger.Read.account <* Text.Parsec.eof)
+ () "" "A:B:C"])
+ ~?=
+ [["A", "B", "C"]]
+ , "\"Aa:Bbb:Cccc\" = Right [\"Aa\", \"Bbb\", \":Cccc\"]" ~:
+ (Data.Either.rights $
+ [Text.Parsec.runParser
+ (Format.Ledger.Read.account <* Text.Parsec.eof)
+ () "" "Aa:Bbb:Cccc"])
+ ~?=
+ [["Aa", "Bbb", "Cccc"]]
+ , "\"A a : B b b : C c c c\" = Right [\"A a \", \" B b b \", \": C c c c\"]" ~:
+ (Data.Either.rights $
+ [Text.Parsec.runParser
+ (Format.Ledger.Read.account <* Text.Parsec.eof)
+ () "" "A a : B b b : C c c c"])
+ ~?=
+ [["A a ", " B b b ", " C c c c"]]
+ , "\"A: :C\" = Right [\"A\", \" \", \"C\"]" ~:
+ (Data.Either.rights $
+ [Text.Parsec.runParser
+ (Format.Ledger.Read.account <* Text.Parsec.eof)
+ () "" "A: :C"])
+ ~?=
+ [["A", " ", "C"]]
+ , "\"A::C\" = Left" ~:
+ (Data.Either.rights $
+ [Text.Parsec.runParser
+ (Format.Ledger.Read.account <* Text.Parsec.eof)
+ () "" "A::C"])
+ ~?=
+ []
+ ]
+ , "amount" ~: TestList
+ [ "\"\" = Left" ~:
+ (Data.Either.rights $
+ [Text.Parsec.runParser
+ (Format.Ledger.Read.amount <* Text.Parsec.eof)
+ () "" ""])
+ ~?=
+ []
+ , "\"0\" = Right 0" ~:
+ (Data.Either.rights $
+ [Text.Parsec.runParser
+ (Format.Ledger.Read.amount <* Text.Parsec.eof)
+ () "" "0"])
+ ~?=
+ [Amount.nil
+ { Amount.quantity = Data.Decimal.Decimal 0 0
+ }]
+ , "\"00\" = Right 0" ~:
+ (Data.Either.rights $
+ [Text.Parsec.runParser
+ (Format.Ledger.Read.amount <* Text.Parsec.eof)
+ () "" "00"])
+ ~?=
+ [Amount.nil
+ { Amount.quantity = Data.Decimal.Decimal 0 0
+ }]
+ , "\"0.\" = Right 0." ~:
+ (Data.Either.rights $
+ [Text.Parsec.runParser
+ (Format.Ledger.Read.amount <* Text.Parsec.eof)
+ () "" "0."])
+ ~?=
+ [Amount.nil
+ { Amount.quantity = Data.Decimal.Decimal 0 0
+ , Amount.style =
+ Style.nil
+ { Style.fractioning = Just '.'
+ }
+ }]
+ , "\".0\" = Right 0.0" ~:
+ (Data.Either.rights $
+ [Text.Parsec.runParser
+ (Format.Ledger.Read.amount <* Text.Parsec.eof)
+ () "" ".0"])
+ ~?=
+ [Amount.nil
+ { Amount.quantity = Data.Decimal.Decimal 0 0
+ , Amount.style =
+ Style.nil
+ { Style.fractioning = Just '.'
+ , Style.precision = 1
+ }
+ }]
+ , "\"0,\" = Right 0," ~:
+ (Data.Either.rights $
+ [Text.Parsec.runParser
+ (Format.Ledger.Read.amount <* Text.Parsec.eof)
+ () "" "0,"])
+ ~?=
+ [Amount.nil
+ { Amount.quantity = Data.Decimal.Decimal 0 0
+ , Amount.style =
+ Style.nil
+ { Style.fractioning = Just ','
+ }
+ }]
+ , "\",0\" = Right 0,0" ~:
+ (Data.Either.rights $
+ [Text.Parsec.runParser
+ (Format.Ledger.Read.amount <* Text.Parsec.eof)
+ () "" ",0"])
+ ~?=
+ [Amount.nil
+ { Amount.quantity = Data.Decimal.Decimal 0 0
+ , Amount.style =
+ Style.nil
+ { Style.fractioning = Just ','
+ , Style.precision = 1
+ }
+ }]
+ , "\"0_\" = Left" ~:
+ (Data.Either.rights $
+ [Text.Parsec.runParser
+ (Format.Ledger.Read.amount <* Text.Parsec.eof)
+ () "" "0_"])
+ ~?=
+ []
+ , "\"_0\" = Left" ~:
+ (Data.Either.rights $
+ [Text.Parsec.runParser
+ (Format.Ledger.Read.amount <* Text.Parsec.eof)
+ () "" "_0"])
+ ~?=
+ []
+ , "\"0.0\" = Right 0.0" ~:
+ (Data.Either.rights $
+ [Text.Parsec.runParser
+ (Format.Ledger.Read.amount <* Text.Parsec.eof)
+ () "" "0.0"])
+ ~?=
+ [Amount.nil
+ { Amount.quantity = Data.Decimal.Decimal 0 0
+ , Amount.style =
+ Style.nil
+ { Style.fractioning = Just '.'
+ , Style.precision = 1
+ }
+ }]
+ , "\"00.00\" = Right 0.00" ~:
+ (Data.Either.rights $
+ [Text.Parsec.runParser
+ (Format.Ledger.Read.amount <* Text.Parsec.eof)
+ () "" "00.00"])
+ ~?=
+ [Amount.nil
+ { Amount.quantity = Data.Decimal.Decimal 0 0
+ , Amount.style =
+ Style.nil
+ { Style.fractioning = Just '.'
+ , Style.precision = 2
+ }
+ }]
+ , "\"0,0\" = Right 0,0" ~:
+ (Data.Either.rights $
+ [Text.Parsec.runParser
+ (Format.Ledger.Read.amount <* Text.Parsec.eof)
+ () "" "0,0"])
+ ~?=
+ [Amount.nil
+ { Amount.quantity = Data.Decimal.Decimal 0 0
+ , Amount.style =
+ Style.nil
+ { Style.fractioning = Just ','
+ , Style.precision = 1
+ }
+ }]
+ , "\"00,00\" = Right 0,00" ~:
+ (Data.Either.rights $
+ [Text.Parsec.runParser
+ (Format.Ledger.Read.amount <* Text.Parsec.eof)
+ () "" "00,00"])
+ ~?=
+ [Amount.nil
+ { Amount.quantity = Data.Decimal.Decimal 0 0
+ , Amount.style =
+ Style.nil
+ { Style.fractioning = Just ','
+ , Style.precision = 2
+ }
+ }]
+ , "\"0_0\" = Right 0" ~:
+ (Data.Either.rights $
+ [Text.Parsec.runParser
+ (Format.Ledger.Read.amount <* Text.Parsec.eof)
+ () "" "0_0"])
+ ~?=
+ [Amount.nil
+ { Amount.quantity = Data.Decimal.Decimal 0 0
+ , Amount.style =
+ Style.nil
+ { Style.fractioning = Nothing
+ , Style.grouping_integral = Just $ Style.Grouping '_' [1]
+ , Style.precision = 0
+ }
+ }]
+ , "\"00_00\" = Right 0" ~:
+ (Data.Either.rights $
+ [Text.Parsec.runParser
+ (Format.Ledger.Read.amount <* Text.Parsec.eof)
+ () "" "00_00"])
+ ~?=
+ [Amount.nil
+ { Amount.quantity = Data.Decimal.Decimal 0 0
+ , Amount.style =
+ Style.nil
+ { Style.fractioning = Nothing
+ , Style.grouping_integral = Just $ Style.Grouping '_' [2]
+ , Style.precision = 0
+ }
+ }]
+ , "\"0,000.00\" = Right 0,000.00" ~:
+ (Data.Either.rights $
+ [Text.Parsec.runParser
+ (Format.Ledger.Read.amount <* Text.Parsec.eof)
+ () "" "0,000.00"])
+ ~?=
+ [Amount.nil
+ { Amount.quantity = Data.Decimal.Decimal 0 0
+ , Amount.style =
+ Style.nil
+ { Style.fractioning = Just '.'
+ , Style.grouping_integral = Just $ Style.Grouping ',' [3]
+ , Style.precision = 2
+ }
+ }]
+ , "\"0.000,00\" = Right 0.000,00" ~:
+ (Data.Either.rights $
+ [Text.Parsec.runParser
+ (Format.Ledger.Read.amount)
+ () "" "0.000,00"])
+ ~?=
+ [Amount.nil
+ { Amount.quantity = Data.Decimal.Decimal 0 0
+ , Amount.style =
+ Style.nil
+ { Style.fractioning = Just ','
+ , Style.grouping_integral = Just $ Style.Grouping '.' [3]
+ , Style.precision = 2
+ }
+ }]
+ , "\"1,000.00\" = Right 1,000.00" ~:
+ (Data.Either.rights $
+ [Text.Parsec.runParser
+ (Format.Ledger.Read.amount <* Text.Parsec.eof)
+ () "" "1,000.00"])
+ ~?=
+ [Amount.nil
+ { Amount.quantity = Data.Decimal.Decimal 0 1000
+ , Amount.style =
+ Style.nil
+ { Style.fractioning = Just '.'
+ , Style.grouping_integral = Just $ Style.Grouping ',' [3]
+ , Style.precision = 2
+ }
+ }]
+ , "\"1.000,00\" = Right 1.000,00" ~:
+ (Data.Either.rights $
+ [Text.Parsec.runParser
+ (Format.Ledger.Read.amount)
+ () "" "1.000,00"])
+ ~?=
+ [Amount.nil
+ { Amount.quantity = Data.Decimal.Decimal 0 1000
+ , Amount.style =
+ Style.nil
+ { Style.fractioning = Just ','
+ , Style.grouping_integral = Just $ Style.Grouping '.' [3]
+ , Style.precision = 2
+ }
+ }]
+ , "\"1,000.00.\" = Left" ~:
+ (Data.Either.rights $
+ [Text.Parsec.runParser
+ (Format.Ledger.Read.amount)
+ () "" "1,000.00."])
+ ~?=
+ []
+ , "\"1.000,00,\" = Left" ~:
+ (Data.Either.rights $
+ [Text.Parsec.runParser
+ (Format.Ledger.Read.amount)
+ () "" "1.000,00,"])
+ ~?=
+ []
+ , "\"1,000.00_\" = Left" ~:
+ (Data.Either.rights $
+ [Text.Parsec.runParser
+ (Format.Ledger.Read.amount)
+ () "" "1,000.00_"])
+ ~?=
+ []
+ , "\"12\" = Right 12" ~:
+ (Data.Either.rights $
+ [Text.Parsec.runParser
+ (Format.Ledger.Read.amount <* Text.Parsec.eof)
+ () "" "123"])
+ ~?=
+ [Amount.nil
+ { Amount.quantity = Data.Decimal.Decimal 0 123
+ }]
+ , "\"1.2\" = Right 1.2" ~:
+ (Data.Either.rights $
+ [Text.Parsec.runParser
+ (Format.Ledger.Read.amount <* Text.Parsec.eof)
+ () "" "1.2"])
+ ~?=
+ [Amount.nil
+ { Amount.quantity = Data.Decimal.Decimal 1 12
+ , Amount.style =
+ Style.nil
+ { Style.fractioning = Just '.'
+ , Style.precision = 1
+ }
+ }]
+ , "\"1,2\" = Right 1,2" ~:
+ (Data.Either.rights $
+ [Text.Parsec.runParser
+ (Format.Ledger.Read.amount <* Text.Parsec.eof)
+ () "" "1,2"])
+ ~?=
+ [Amount.nil
+ { Amount.quantity = Data.Decimal.Decimal 1 12
+ , Amount.style =
+ Style.nil
+ { Style.fractioning = Just ','
+ , Style.precision = 1
+ }
+ }]
+ , "\"12.23\" = Right 12.23" ~:
+ (Data.Either.rights $
+ [Text.Parsec.runParser
+ (Format.Ledger.Read.amount <* Text.Parsec.eof)
+ () "" "12.34"])
+ ~?=
+ [Amount.nil
+ { Amount.quantity = Data.Decimal.Decimal 2 1234
+ , Amount.style =
+ Style.nil
+ { Style.fractioning = Just '.'
+ , Style.precision = 2
+ }
+ }]
+ , "\"12,23\" = Right 12,23" ~:
+ (Data.Either.rights $
+ [Text.Parsec.runParser
+ (Format.Ledger.Read.amount <* Text.Parsec.eof)
+ () "" "12,34"])
+ ~?=
+ [Amount.nil
+ { Amount.quantity = Data.Decimal.Decimal 2 1234
+ , Amount.style =
+ Style.nil
+ { Style.fractioning = Just ','
+ , Style.precision = 2
+ }
+ }]
+ , "\"1_2\" = Right 1_2" ~:
+ (Data.Either.rights $
+ [Text.Parsec.runParser
+ (Format.Ledger.Read.amount <* Text.Parsec.eof)
+ () "" "1_2"])
+ ~?=
+ [Amount.nil
+ { Amount.quantity = Data.Decimal.Decimal 0 12
+ , Amount.style =
+ Style.nil
+ { Style.grouping_integral = Just $ Style.Grouping '_' [1]
+ , Style.precision = 0
+ }
+ }]
+ , "\"1_23\" = Right 1_23" ~:
+ (Data.Either.rights $
+ [Text.Parsec.runParser
+ (Format.Ledger.Read.amount <* Text.Parsec.eof)
+ () "" "1_23"])
+ ~?=
+ [Amount.nil
+ { Amount.quantity = Data.Decimal.Decimal 0 123
+ , Amount.style =
+ Style.nil
+ { Style.grouping_integral = Just $ Style.Grouping '_' [2]
+ , Style.precision = 0
+ }
+ }]
+ , "\"1_23_456\" = Right 1_23_456" ~:
+ (Data.Either.rights $
+ [Text.Parsec.runParser
+ (Format.Ledger.Read.amount <* Text.Parsec.eof)
+ () "" "1_23_456"])
+ ~?=
+ [Amount.nil
+ { Amount.quantity = Data.Decimal.Decimal 0 123456
+ , Amount.style =
+ Style.nil
+ { Style.grouping_integral = Just $ Style.Grouping '_' [3, 2]
+ , Style.precision = 0
+ }
+ }]
+ , "\"1_23_456.7890_12345_678901\" = Right 1_23_456.7890_12345_678901" ~:
+ (Data.Either.rights $
+ [Text.Parsec.runParser
+ (Format.Ledger.Read.amount <* Text.Parsec.eof)
+ () "" "1_23_456.7890_12345_678901"])
+ ~?=
+ [Amount.nil
+ { Amount.quantity = Data.Decimal.Decimal 15 123456789012345678901
+ , Amount.style =
+ Style.nil
+ { Style.fractioning = Just '.'
+ , Style.grouping_integral = Just $ Style.Grouping '_' [3, 2]
+ , Style.grouping_fractional = Just $ Style.Grouping '_' [4, 5, 6]
+ , Style.precision = 15
+ }
+ }]
+ , "\"123456_78901_2345.678_90_1\" = Right 123456_78901_2345.678_90_1" ~:
+ (Data.Either.rights $
+ [Text.Parsec.runParser
+ (Format.Ledger.Read.amount <* Text.Parsec.eof)
+ () "" "123456_78901_2345.678_90_1"])
+ ~?=
+ [Amount.nil
+ { Amount.quantity = Data.Decimal.Decimal 6 123456789012345678901
+ , Amount.style =
+ Style.nil
+ { Style.fractioning = Just '.'
+ , Style.grouping_integral = Just $ Style.Grouping '_' [4, 5, 6]
+ , Style.grouping_fractional = Just $ Style.Grouping '_' [3, 2]
+ , Style.precision = 6
+ }
+ }]
+ , "\"$1\" = Right $1" ~:
+ (Data.Either.rights $
+ [Text.Parsec.runParser
+ (Format.Ledger.Read.amount <* Text.Parsec.eof)
+ () "" "$1"])
+ ~?=
+ [Amount.nil
+ { Amount.quantity = Data.Decimal.Decimal 0 1
+ , Amount.style =
+ Style.nil
+ { Style.fractioning = Nothing
+ , Style.grouping_integral = Nothing
+ , Style.grouping_fractional = Nothing
+ , Style.precision = 0
+ , Style.unit_side = Just Style.Side_Left
+ , Style.unit_spaced = Just False
+ }
+ , Amount.unit = "$"
+ }]
+ , "\"1$\" = Right 1$" ~:
+ (Data.Either.rights $
+ [Text.Parsec.runParser
+ (Format.Ledger.Read.amount <* Text.Parsec.eof)
+ () "" "1$"])
+ ~?=
+ [Amount.nil
+ { Amount.quantity = Data.Decimal.Decimal 0 1
+ , Amount.style =
+ Style.nil
+ { Style.fractioning = Nothing
+ , Style.grouping_integral = Nothing
+ , Style.grouping_fractional = Nothing
+ , Style.precision = 0
+ , Style.unit_side = Just Style.Side_Right
+ , Style.unit_spaced = Just False
+ }
+ , Amount.unit = "$"
+ }]
+ , "\"$ 1\" = Right $ 1" ~:
+ (Data.Either.rights $
+ [Text.Parsec.runParser
+ (Format.Ledger.Read.amount <* Text.Parsec.eof)
+ () "" "$ 1"])
+ ~?=
+ [Amount.nil
+ { Amount.quantity = Data.Decimal.Decimal 0 1
+ , Amount.style =
+ Style.nil
+ { Style.fractioning = Nothing
+ , Style.grouping_integral = Nothing
+ , Style.grouping_fractional = Nothing
+ , Style.precision = 0
+ , Style.unit_side = Just Style.Side_Left
+ , Style.unit_spaced = Just True
+ }
+ , Amount.unit = "$"
+ }]
+ , "\"1 $\" = Right 1 $" ~:
+ (Data.Either.rights $
+ [Text.Parsec.runParser
+ (Format.Ledger.Read.amount <* Text.Parsec.eof)
+ () "" "1 $"])
+ ~?=
+ [Amount.nil
+ { Amount.quantity = Data.Decimal.Decimal 0 1
+ , Amount.style =
+ Style.nil
+ { Style.fractioning = Nothing
+ , Style.grouping_integral = Nothing
+ , Style.grouping_fractional = Nothing
+ , Style.precision = 0
+ , Style.unit_side = Just Style.Side_Right
+ , Style.unit_spaced = Just True
+ }
+ , Amount.unit = "$"
+ }]
+ , "\"-$1\" = Right $-1" ~:
+ (Data.Either.rights $
+ [Text.Parsec.runParser
+ (Format.Ledger.Read.amount <* Text.Parsec.eof)
+ () "" "-$1"])
+ ~?=
+ [Amount.nil
+ { Amount.quantity = Data.Decimal.Decimal 0 (-1)
+ , Amount.style =
+ Style.nil
+ { Style.fractioning = Nothing
+ , Style.grouping_integral = Nothing
+ , Style.grouping_fractional = Nothing
+ , Style.precision = 0
+ , Style.unit_side = Just Style.Side_Left
+ , Style.unit_spaced = Just False
+ }
+ , Amount.unit = "$"
+ }]
+ , "\"\\\"4 2\\\"1\" = Right \\\"4 2\\\"1" ~:
+ (Data.Either.rights $
+ [Text.Parsec.runParser
+ (Format.Ledger.Read.amount <* Text.Parsec.eof)
+ () "" "\"4 2\"1"])
+ ~?=
+ [Amount.nil
+ { Amount.quantity = Data.Decimal.Decimal 0 1
+ , Amount.style =
+ Style.nil
+ { Style.fractioning = Nothing
+ , Style.grouping_integral = Nothing
+ , Style.grouping_fractional = Nothing
+ , Style.precision = 0
+ , Style.unit_side = Just Style.Side_Left
+ , Style.unit_spaced = Just False
+ }
+ , Amount.unit = "4 2"
+ }]
+ , "\"1\\\"4 2\\\"\" = Right 1\\\"4 2\\\"" ~:
+ (Data.Either.rights $
+ [Text.Parsec.runParser
+ (Format.Ledger.Read.amount <* Text.Parsec.eof)
+ () "" "1\"4 2\""])
+ ~?=
+ [Amount.nil
+ { Amount.quantity = Data.Decimal.Decimal 0 1
+ , Amount.style =
+ Style.nil
+ { Style.fractioning = Nothing
+ , Style.grouping_integral = Nothing
+ , Style.grouping_fractional = Nothing
+ , Style.precision = 0
+ , Style.unit_side = Just Style.Side_Right
+ , Style.unit_spaced = Just False
+ }
+ , Amount.unit = "4 2"
+ }]
+ , "\"$1.000,00\" = Right $1.000,00" ~:
+ (Data.Either.rights $
+ [Text.Parsec.runParser
+ (Format.Ledger.Read.amount <* Text.Parsec.eof)
+ () "" "$1.000,00"])
+ ~?=
+ [Amount.nil
+ { Amount.quantity = Data.Decimal.Decimal 0 1000
+ , Amount.style =
+ Style.nil
+ { Style.fractioning = Just ','
+ , Style.grouping_integral = Just $ Style.Grouping '.' [3]
+ , Style.grouping_fractional = Nothing
+ , Style.precision = 2
+ , Style.unit_side = Just Style.Side_Left
+ , Style.unit_spaced = Just False
+ }
+ , Amount.unit = "$"
+ }]
+ , "\"1.000,00$\" = Right 1.000,00$" ~:
+ (Data.Either.rights $
+ [Text.Parsec.runParser
+ (Format.Ledger.Read.amount <* Text.Parsec.eof)
+ () "" "1.000,00$"])
+ ~?=
+ [Amount.nil
+ { Amount.quantity = Data.Decimal.Decimal 0 1000
+ , Amount.style =
+ Style.nil
+ { Style.fractioning = Just ','
+ , Style.grouping_integral = Just $ Style.Grouping '.' [3]
+ , Style.grouping_fractional = Nothing
+ , Style.precision = 2
+ , Style.unit_side = Just Style.Side_Right
+ , Style.unit_spaced = Just False
+ }
+ , Amount.unit = "$"
+ }]
+ ]
+ ]
+ ]
+ ]
]
hcompta-lib
, base >= 4.3 && < 5
, containers
+ , Decimal
, HUnit
+ , parsec
, safe
, test-framework
, test-framework-hunit
sourcephile / git / comptalang.git / commitdiff