    -- {-# OPTIONS_GHC -F -pgmF htfpp #-}
    {-# LANGUAGE CPP, RecordWildCards, NoMonoLocalBinds #-}
    {-|

    A reader for hledger's journal file format
    (<http://hledger.org/MANUAL.html#the-journal-file>).  hledger's journal
    format is a compatible subset of c++ ledger's
    (<http://ledger-cli.org/3.0/doc/ledger3.html#Journal-Format>), so this
    reader should handle many ledger files as well. Example:

    @
    2012\/3\/24 gift
        expenses:gifts  $10
        assets:cash
    @

    -}

    module Hledger.Read.JournalReader (
      -- * Reader
      reader,
      -- * Parsers used elsewhere
      parseJournalWith,
      getParentAccount,
      journal,
      directive,
      defaultyeardirective,
      historicalpricedirective,
      datetime,
      code,
      accountname,
      amountp,
      amountp',
      mamountp',
      emptyline
    #ifdef TESTS
      -- * Tests
      -- disabled by default, HTF not available on windows
      ,htf_thisModulesTests
      ,htf_Hledger_Read_JournalReader_importedTests
    #endif
    )
    where
    import qualified Control.Exception as C
    import Control.Monad
    import Control.Monad.Error
    import Data.Char (isNumber)
    import Data.List
    import Data.List.Split (wordsBy)
    import Data.Maybe
    import Data.Time.Calendar
    import Data.Time.LocalTime
    import Safe (headDef, lastDef)
    #ifdef TESTS
    import Test.Framework
    import Text.Parsec.Error
    #endif
    import Text.ParserCombinators.Parsec hiding (parse)
    import Text.Printf
    import System.FilePath
    import System.Time (getClockTime)

    import Hledger.Data
    import Hledger.Utils
    import Prelude hiding (readFile)

    -- standard reader exports

    reader :: Reader
    reader = Reader format detect parse

    format :: String
    format = "journal"

    -- | Does the given file path and data provide hledger's journal file format ?
    detect :: FilePath -> String -> Bool
    detect f _ = takeExtension f `elem` ['.':format, ".j"]

    -- | Parse and post-process a "Journal" from hledger's journal file
    -- format, or give an error.
    parse :: Maybe FilePath -> FilePath -> String -> ErrorT String IO Journal
    parse _ = -- trace ("running "++format++" reader") .
              parseJournalWith journal

    -- parsing utils

    -- | Flatten a list of JournalUpdate's into a single equivalent one.
    combineJournalUpdates :: [JournalUpdate] -> JournalUpdate
    combineJournalUpdates us = liftM (foldl' (.) id) $ sequence us

    -- | Given a JournalUpdate-generating parsec parser, file path and data string,
    -- parse and post-process a Journal so that it's ready to use, or give an error.
    parseJournalWith :: (GenParser Char JournalContext (JournalUpdate,JournalContext)) -> FilePath -> String -> ErrorT String IO Journal
    parseJournalWith p f s = do
      tc <- liftIO getClockTime
      tl <- liftIO getCurrentLocalTime
      y <- liftIO getCurrentYear
      case runParser p nullctx{ctxYear=Just y} f s of
        Right (updates,ctx) -> do
                               j <- updates `ap` return nulljournal
                               case journalFinalise tc tl f s ctx j of
                                 Right j'  -> return j'
                                 Left estr -> throwError estr
        Left e -> throwError $ show e

    setYear :: Integer -> GenParser tok JournalContext ()
    setYear y = updateState (\ctx -> ctx{ctxYear=Just y})

    getYear :: GenParser tok JournalContext (Maybe Integer)
    getYear = liftM ctxYear getState

    setCommodityAndStyle :: (Commodity,AmountStyle) -> GenParser tok JournalContext ()
    setCommodityAndStyle cs = updateState (\ctx -> ctx{ctxCommodityAndStyle=Just cs})

    getCommodityAndStyle :: GenParser tok JournalContext (Maybe (Commodity,AmountStyle))
    getCommodityAndStyle = ctxCommodityAndStyle `fmap` getState

    pushParentAccount :: String -> GenParser tok JournalContext ()
    pushParentAccount parent = updateState addParentAccount
        where addParentAccount ctx0 = ctx0 { ctxAccount = parent : ctxAccount ctx0 }

    popParentAccount :: GenParser tok JournalContext ()
    popParentAccount = do ctx0 <- getState
                          case ctxAccount ctx0 of
                            [] -> unexpected "End of account block with no beginning"
                            (_:rest) -> setState $ ctx0 { ctxAccount = rest }

    getParentAccount :: GenParser tok JournalContext String
    getParentAccount = liftM (concatAccountNames . reverse . ctxAccount) getState

    addAccountAlias :: (AccountName,AccountName) -> GenParser tok JournalContext ()
    addAccountAlias a = updateState (\(ctx@Ctx{..}) -> ctx{ctxAliases=a:ctxAliases})

    getAccountAliases :: GenParser tok JournalContext [(AccountName,AccountName)]
    getAccountAliases = liftM ctxAliases getState

    clearAccountAliases :: GenParser tok JournalContext ()
    clearAccountAliases = updateState (\(ctx@Ctx{..}) -> ctx{ctxAliases=[]})

    -- parsers

    -- | Top-level journal parser. Returns a single composite, I/O performing,
    -- error-raising "JournalUpdate" (and final "JournalContext") which can be
    -- applied to an empty journal to get the final result.
    journal :: GenParser Char JournalContext (JournalUpdate,JournalContext)
    journal = do
      journalupdates <- many journalItem
      eof
      finalctx <- getState
      return $ (combineJournalUpdates journalupdates, finalctx)
        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) transaction
                               , liftM (return . addModifierTransaction) modifiertransaction
                               , liftM (return . addPeriodicTransaction) periodictransaction
                               , liftM (return . addHistoricalPrice) historicalpricedirective
                               , emptyline >> return (return id)
                               ] <?> "journal transaction or directive"

    -- cf http://ledger-cli.org/3.0/doc/ledger3.html#Command-Directives
    directive :: GenParser Char JournalContext JournalUpdate
    directive = do
      optional $ char '!'
      choice' [
        includedirective
       ,aliasdirective
       ,endaliasesdirective
       ,accountdirective
       ,enddirective
       ,tagdirective
       ,endtagdirective
       ,defaultyeardirective
       ,defaultcommoditydirective
       ,commodityconversiondirective
       ,ignoredpricecommoditydirective
       ]
      <?> "directive"

    includedirective :: GenParser Char JournalContext JournalUpdate
    includedirective = do
      string "include"
      many1 spacenonewline
      filename <- restofline
      outerState <- getState
      outerPos <- getPosition
      let curdir = takeDirectory (sourceName outerPos)
      return $ do filepath <- expandPath curdir filename
                  txt <- readFileOrError outerPos filepath
                  let inIncluded = show outerPos ++ " in included file " ++ show filename ++ ":\n"
                  case runParser journal outerState filepath txt of
                    Right (ju,_) -> combineJournalUpdates [return $ journalAddFile (filepath,txt), ju] `catchError` (throwError . (inIncluded ++))
                    Left err     -> throwError $ inIncluded ++ show err
          where readFileOrError pos fp =
                    ErrorT $ liftM Right (readFile' fp) `C.catch`
                      \e -> return $ Left $ printf "%s reading %s:\n%s" (show pos) fp (show (e::C.IOException))

    journalAddFile :: (FilePath,String) -> Journal -> Journal
    journalAddFile f j@Journal{files=fs} = j{files=fs++[f]}
      -- XXX currently called in reverse order of includes, I can't see why

    accountdirective :: GenParser Char JournalContext JournalUpdate
    accountdirective = do
      string "account"
      many1 spacenonewline
      parent <- accountname
      newline
      pushParentAccount parent
      return $ return id

    enddirective :: GenParser Char JournalContext JournalUpdate
    enddirective = do
      string "end"
      popParentAccount
      return (return id)

    aliasdirective :: GenParser Char JournalContext JournalUpdate
    aliasdirective = do
      string "alias"
      many1 spacenonewline
      orig <- many1 $ noneOf "="
      char '='
      alias <- restofline
      addAccountAlias (accountNameWithoutPostingType $ strip orig
                      ,accountNameWithoutPostingType $ strip alias)
      return $ return id

    endaliasesdirective :: GenParser Char JournalContext JournalUpdate
    endaliasesdirective = do
      string "end aliases"
      clearAccountAliases
      return (return id)

    tagdirective :: GenParser Char JournalContext JournalUpdate
    tagdirective = do
      string "tag" <?> "tag directive"
      many1 spacenonewline
      _ <- many1 nonspace
      restofline
      return $ return id

    endtagdirective :: GenParser Char JournalContext JournalUpdate
    endtagdirective = do
      (string "end tag" <|> string "pop") <?> "end tag or pop directive"
      restofline
      return $ return id

    defaultyeardirective :: GenParser Char JournalContext JournalUpdate
    defaultyeardirective = do
      char 'Y' <?> "default year"
      many spacenonewline
      y <- many1 digit
      let y' = read y
      failIfInvalidYear y
      setYear y'
      return $ return id

    defaultcommoditydirective :: GenParser Char JournalContext JournalUpdate
    defaultcommoditydirective = do
      char 'D' <?> "default commodity"
      many1 spacenonewline
      Amount{..} <- amountp
      setCommodityAndStyle (acommodity, astyle)
      restofline
      return $ return id

    historicalpricedirective :: GenParser Char JournalContext HistoricalPrice
    historicalpricedirective = do
      char 'P' <?> "historical price"
      many spacenonewline
      date <- try (do {LocalTime d _ <- datetime; return d}) <|> date -- a time is ignored
      many1 spacenonewline
      symbol <- commoditysymbol
      many spacenonewline
      price <- amountp
      restofline
      return $ HistoricalPrice date symbol price

    ignoredpricecommoditydirective :: GenParser Char JournalContext JournalUpdate
    ignoredpricecommoditydirective = do
      char 'N' <?> "ignored-price commodity"
      many1 spacenonewline
      commoditysymbol
      restofline
      return $ return id

    commodityconversiondirective :: GenParser Char JournalContext JournalUpdate
    commodityconversiondirective = do
      char 'C' <?> "commodity conversion"
      many1 spacenonewline
      amountp
      many spacenonewline
      char '='
      many spacenonewline
      amountp
      restofline
      return $ return id

    modifiertransaction :: GenParser Char JournalContext ModifierTransaction
    modifiertransaction = do
      char '=' <?> "modifier transaction"
      many spacenonewline
      valueexpr <- restofline
      postings <- postings
      return $ ModifierTransaction valueexpr postings

    periodictransaction :: GenParser Char JournalContext PeriodicTransaction
    periodictransaction = do
      char '~' <?> "periodic transaction"
      many spacenonewline
      periodexpr <- restofline
      postings <- postings
      return $ PeriodicTransaction periodexpr postings

    -- | Parse a (possibly unbalanced) transaction.
    transaction :: GenParser Char JournalContext Transaction
    transaction = do
      -- ptrace "transaction"
      date <- date <?> "transaction"
      edate <- optionMaybe (secondarydate date) <?> "secondary date"
      status <- status <?> "cleared flag"
      code <- code <?> "transaction code"
      description <- descriptionp >>= return . strip
      comment <- try followingcomment <|> (newline >> return "")
      let tags = tagsInComment comment
      postings <- postings
      return $ txnTieKnot $ Transaction date edate status code description comment tags postings ""

    descriptionp = many (noneOf ";\n")

    #ifdef TESTS
    test_transaction = do
        let s `gives` t = do
                            let p = parseWithCtx nullctx transaction s
                            assertBool $ isRight p
                            let Right t2 = p
                                -- same f = assertEqual (f t) (f t2)
                            assertEqual (tdate t) (tdate t2)
                            assertEqual (tdate2 t) (tdate2 t2)
                            assertEqual (tstatus t) (tstatus t2)
                            assertEqual (tcode t) (tcode t2)
                            assertEqual (tdescription t) (tdescription t2)
                            assertEqual (tcomment t) (tcomment t2)
                            assertEqual (ttags t) (ttags t2)
                            assertEqual (tpreceding_comment_lines t) (tpreceding_comment_lines t2)
                            assertEqual (show $ tpostings t) (show $ tpostings t2)
        -- "0000/01/01\n\n" `gives` nulltransaction
        unlines [
          "2012/05/14=2012/05/15 (code) desc  ; tcomment1",
          "    ; tcomment2",
          "    ; ttag1: val1",
          "    * a         $1.00  ; pcomment1",
          "    ; pcomment2",
          "    ; ptag1: val1",
          "    ; ptag2: val2"
          ]
         `gives`
         nulltransaction{
          tdate=parsedate "2012/05/14",
          tdate2=Just $ parsedate "2012/05/15",
          tstatus=False,
          tcode="code",
          tdescription="desc",
          tcomment=" tcomment1\n tcomment2\n ttag1: val1\n",
          ttags=[("ttag1","val1")],
          tpostings=[
            nullposting{
              pstatus=True,
              paccount="a",
              pamount=Mixed [usd 1],
              pcomment=" pcomment1\n pcomment2\n ptag1: val1\n  ptag2: val2\n",
              ptype=RegularPosting,
              ptags=[("ptag1","val1"),("ptag2","val2")],
              ptransaction=Nothing
              }
            ],
          tpreceding_comment_lines=""
          }

        assertRight $ parseWithCtx nullctx transaction $ unlines
          ["2007/01/28 coopportunity"
          ,"    expenses:food:groceries                   $47.18"
          ,"    assets:checking                          $-47.18"
          ,""
          ]

        -- transaction should not parse just a date
        assertLeft $ parseWithCtx nullctx transaction "2009/1/1\n"

        -- transaction should not parse just a date and description
        assertLeft $ parseWithCtx nullctx transaction "2009/1/1 a\n"

        -- transaction should not parse a following comment as part of the description
        let p = parseWithCtx nullctx transaction "2009/1/1 a ;comment\n b 1\n"
        assertRight p
        assertEqual "a" (let Right p' = p in tdescription p')

        -- parse transaction with following whitespace line
        assertRight $ parseWithCtx nullctx transaction $ unlines
            ["2012/1/1"
            ,"  a  1"
            ,"  b"
            ," "
            ]

        let p = parseWithCtx nullctx transaction $ unlines
                 ["2009/1/1 x  ; transaction comment"
                 ," a  1  ; posting 1 comment"
                 ," ; posting 1 comment 2"
                 ," b"
                 ," ; posting 2 comment"
                 ]
        assertRight p
        assertEqual 2 (let Right t = p in length $ tpostings t)
    #endif

    -- | 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.
    date :: GenParser Char JournalContext Day
    date = 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
      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.
    datetime :: GenParser Char JournalContext LocalTime
    datetime = do
      day <- date
      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')

    secondarydate :: Day -> GenParser Char JournalContext Day
    secondarydate 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 date
      return edate

    status :: GenParser Char JournalContext Bool
    status = try (do { many spacenonewline; (char '*' <|> char '!') <?> "status"; return True } ) <|> return False

    code :: GenParser Char JournalContext String
    code = try (do { many1 spacenonewline; char '(' <?> "code"; code <- anyChar `manyTill` char ')'; return code } ) <|> return ""

    -- Parse the following whitespace-beginning lines as postings, posting tags, and/or comments.
    postings :: GenParser Char JournalContext [Posting]
    postings = many1 (try postingp) <?> "postings"

    -- linebeginningwithspaces :: GenParser Char JournalContext String
    -- linebeginningwithspaces = do
    --   sp <- many1 spacenonewline
    --   c <- nonspace
    --   cs <- restofline
    --   return $ sp ++ (c:cs) ++ "\n"

    postingp :: GenParser Char JournalContext Posting
    postingp = do
      many1 spacenonewline
      status <- status
      many spacenonewline
      account <- modifiedaccountname
      let (ptype, account') = (accountNamePostingType account, unbracket account)
      amount <- spaceandamountormissing
      massertion <- balanceassertion
      _ <- fixedlotprice
      many spacenonewline
      ctx <- getState
      comment <- try followingcomment <|> (newline >> return "")
      let tags = tagsInComment comment
      -- oh boy
      d  <- maybe (return Nothing) (either (fail.show) (return.Just)) (parseWithCtx ctx date `fmap` dateValueFromTags tags)
      d2 <- maybe (return Nothing) (either (fail.show) (return.Just)) (parseWithCtx ctx date `fmap` date2ValueFromTags tags)
      return posting{pdate=d, pdate2=d2, pstatus=status, paccount=account', pamount=amount, pcomment=comment, ptype=ptype, ptags=tags, pbalanceassertion=massertion}

    #ifdef TESTS
    test_postingp = do
        let s `gives` ep = do
                             let parse = parseWithCtx nullctx postingp s
                             assertBool -- "postingp parser"
                               $ isRight parse
                             let Right ap = parse
                                 same f = assertEqual (f ep) (f ap)
                             same pdate
                             same pstatus
                             same paccount
                             same pamount
                             same pcomment
                             same ptype
                             same ptags
                             same ptransaction
        "  expenses:food:dining  $10.00   ; a: a a \n   ; b: b b \n" `gives`
          posting{paccount="expenses:food:dining", pamount=Mixed [usd 10], pcomment=" a: a a \n b: b b \n", ptags=[("a","a a"), ("b","b b")]}

        " a  1 ; [2012/11/28]\n" `gives`
          ("a" `post` num 1){pcomment=" [2012/11/28]\n"
                            ,ptags=[("date","2012/11/28")]
                            ,pdate=parsedateM "2012/11/28"}

        " a  1 ; a:a, [=2012/11/28]\n" `gives`
          ("a" `post` num 1){pcomment=" a:a, [=2012/11/28]\n"
                            ,ptags=[("a","a"), ("date2","2012/11/28")]
                            ,pdate=Nothing}

        " a  1 ; a:a\n  ; [2012/11/28=2012/11/29],b:b\n" `gives`
          ("a" `post` num 1){pcomment=" a:a\n [2012/11/28=2012/11/29],b:b\n"
                            ,ptags=[("a","a"), ("date","2012/11/28"), ("date2","2012/11/29"), ("b","b")]
                            ,pdate=parsedateM "2012/11/28"}

        assertBool -- "postingp parses a quoted commodity with numbers"
          (isRight $ parseWithCtx nullctx postingp "  a  1 \"DE123\"\n")

      -- ,"postingp parses balance assertions and fixed lot prices" ~: do
        assertBool (isRight $ parseWithCtx nullctx postingp "  a  1 \"DE123\" =$1 { =2.2 EUR} \n")

        -- let parse = parseWithCtx nullctx postingp " a\n ;next-line comment\n"
        -- assertRight parse
        -- let Right p = parse
        -- assertEqual "next-line comment\n" (pcomment p)
        -- assertEqual (Just nullmixedamt) (pbalanceassertion p)
    #endif

    -- | Parse an account name, then apply any parent account prefix and/or account aliases currently in effect.
    modifiedaccountname :: GenParser Char JournalContext AccountName
    modifiedaccountname = do
      a <- accountname
      prefix <- getParentAccount
      let prefixed = prefix `joinAccountNames` a
      aliases <- getAccountAliases
      return $ accountNameApplyAliases aliases prefixed

    -- | Parse an account name. Account names may have single spaces inside
    -- them, and are terminated by two or more spaces. They should have one or
    -- more components of at least one character, separated by the account
    -- separator char.
    accountname :: GenParser Char st AccountName
    accountname = do
        a <- many1 (nonspace <|> singlespace)
        let a' = striptrailingspace a
        when (accountNameFromComponents (accountNameComponents a') /= a')
             (fail $ "accountname seems ill-formed: "++a')
        return a'
        where
          singlespace = try (do {spacenonewline; do {notFollowedBy spacenonewline; return ' '}})
          -- couldn't avoid consuming a final space sometimes, harmless
          striptrailingspace s = if last s == ' ' then init s else s

    -- 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 :: GenParser Char JournalContext MixedAmount
    spaceandamountormissing =
      try (do
            many1 spacenonewline
            (Mixed . (:[])) `fmap` amountp <|> return missingmixedamt
          ) <|> return missingmixedamt

    #ifdef TESTS
    assertParseEqual' :: (Show a, Eq a) => (Either ParseError a) -> a -> Assertion
    assertParseEqual' parse expected = either (assertFailure.show) (`is'` expected) parse

    is' :: (Eq a, Show a) => a -> a -> Assertion
    a `is'` e = assertEqual e a

    test_spaceandamountormissing = do
        assertParseEqual' (parseWithCtx nullctx spaceandamountormissing " $47.18") (Mixed [usd 47.18])
        assertParseEqual' (parseWithCtx nullctx spaceandamountormissing "$47.18") missingmixedamt
        assertParseEqual' (parseWithCtx nullctx spaceandamountormissing " ") missingmixedamt
        assertParseEqual' (parseWithCtx nullctx spaceandamountormissing "") missingmixedamt
    #endif

    -- | Parse a single-commodity amount, with optional symbol on the left or
    -- right, optional unit or total price, and optional (ignored)
    -- ledger-style balance assertion or fixed lot price declaration.
    amountp :: GenParser Char JournalContext Amount
    amountp = try leftsymbolamount <|> try rightsymbolamount <|> nosymbolamount

    #ifdef TESTS
    test_amountp = do
        assertParseEqual' (parseWithCtx nullctx amountp "$47.18") (usd 47.18)
        assertParseEqual' (parseWithCtx nullctx amountp "$1.") (usd 1 `withPrecision` 0)
      -- ,"amount with unit price" ~: do
        assertParseEqual'
         (parseWithCtx nullctx amountp "$10 @ €0.5")
         (usd 10 `withPrecision` 0 `at` (eur 0.5 `withPrecision` 1))
      -- ,"amount with total price" ~: do
        assertParseEqual'
         (parseWithCtx nullctx amountp "$10 @@ €5")
         (usd 10 `withPrecision` 0 @@ (eur 5 `withPrecision` 0))
    #endif

    -- | Parse an amount from a string, or get an error.
    amountp' :: String -> Amount
    amountp' s = either (error' . show) id $ parseWithCtx nullctx amountp s

    -- | Parse a mixed amount from a string, or get an error.
    mamountp' :: String -> MixedAmount
    mamountp' = mixed . amountp'

    leftsymbolamount :: GenParser Char JournalContext Amount
    leftsymbolamount = do
      sign <- optionMaybe $ string "-"
      let applysign = if isJust sign then negate else id
      c <- commoditysymbol
      sp <- many spacenonewline
      (q,prec,dec,sep,seppos) <- number
      let s = amountstyle{ascommodityside=L, ascommodityspaced=not $ null sp, asdecimalpoint=dec, asprecision=prec, asseparator=sep, asseparatorpositions=seppos}
      p <- priceamount
      return $ applysign $ Amount c q p s
      <?> "left-symbol amount"

    rightsymbolamount :: GenParser Char JournalContext Amount
    rightsymbolamount = do
      (q,prec,dec,sep,seppos) <- number
      sp <- many spacenonewline
      c <- commoditysymbol
      p <- priceamount
      let s = amountstyle{ascommodityside=R, ascommodityspaced=not $ null sp, asdecimalpoint=dec, asprecision=prec, asseparator=sep, asseparatorpositions=seppos}
      return $ Amount c q p s
      <?> "right-symbol amount"

    nosymbolamount :: GenParser Char JournalContext Amount
    nosymbolamount = do
      (q,prec,dec,sep,seppos) <- number
      p <- priceamount
      defcs <- getCommodityAndStyle
      let (c,s) = case defcs of
            Just (c',s') -> (c',s')
            Nothing -> ("", amountstyle{asdecimalpoint=dec, asprecision=prec, asseparator=sep, asseparatorpositions=seppos})
      return $ Amount c q p s
      <?> "no-symbol amount"

    commoditysymbol :: GenParser Char JournalContext String
    commoditysymbol = (quotedcommoditysymbol <|> simplecommoditysymbol) <?> "commodity symbol"

    quotedcommoditysymbol :: GenParser Char JournalContext String
    quotedcommoditysymbol = do
      char '"'
      s <- many1 $ noneOf ";\n\""
      char '"'
      return s

    simplecommoditysymbol :: GenParser Char JournalContext String
    simplecommoditysymbol = many1 (noneOf nonsimplecommoditychars)

    priceamount :: GenParser Char JournalContext Price
    priceamount =
        try (do
              many spacenonewline
              char '@'
              try (do
                    char '@'
                    many spacenonewline
                    a <- amountp -- XXX can parse more prices ad infinitum, shouldn't
                    return $ TotalPrice a)
               <|> (do
                many spacenonewline
                a <- amountp -- XXX can parse more prices ad infinitum, shouldn't
                return $ UnitPrice a))
             <|> return NoPrice

    balanceassertion :: GenParser Char JournalContext (Maybe MixedAmount)
    balanceassertion =
        try (do
              many spacenonewline
              char '='
              many spacenonewline
              a <- amountp -- 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 :: GenParser Char JournalContext (Maybe Amount)
    fixedlotprice =
        try (do
              many spacenonewline
              char '{'
              many spacenonewline
              char '='
              many spacenonewline
              a <- amountp -- XXX should restrict to a simple amount
              many spacenonewline
              char '}'
              return $ Just a)
             <|> return Nothing

    -- | Parse a numeric quantity for its value and display attributes.  Some
    -- international number formats (cf
    -- http://en.wikipedia.org/wiki/Decimal_separator) are accepted: either
    -- period or comma may be used for the decimal point, and the other of
    -- these may be used for separating digit groups in the integer part (eg a
    -- thousands separator).  This returns the numeric value, the precision
    -- (number of digits to the right of the decimal point), the decimal point
    -- and separator characters (defaulting to . and ,), and the positions of
    -- separators (counting leftward from the decimal point, the last is
    -- assumed to repeat).
    number :: GenParser Char JournalContext (Quantity, Int, Char, Char, [Int])
    number = do
      sign <- optionMaybe $ string "-"
      parts <- many1 $ choice' [many1 digit, many1 $ char ',', many1 $ char '.']
      let numeric = isNumber . headDef '_'
          (_, puncparts) = partition numeric parts
          (ok,decimalpoint',separator') =
              case puncparts of
                []     -> (True, Nothing, Nothing)  -- no punctuation chars
                [d:""] -> (True, Just d, Nothing)   -- just one punctuation char, assume it's a decimal point
                [_]    -> (False, Nothing, Nothing) -- adjacent punctuation chars, not ok
                _:_:_  -> let (s:ss, d) = (init puncparts, last puncparts) -- two or more punctuation chars
                         in if (any ((/=1).length) puncparts  -- adjacent punctuation chars, not ok
                                || any (s/=) ss                -- separator chars differ, not ok
                                || head parts == s)            -- number begins with a separator char, not ok
                             then (False, Nothing, Nothing)
                             else if s == d
                                   then (True, Nothing, Just $ head s) -- just one kind of punctuation, assume separator chars
                                   else (True, Just $ head d, Just $ head s) -- separators and a decimal point
      when (not ok) (fail $ "number seems ill-formed: "++concat parts)
      let (intparts',fracparts') = span ((/= decimalpoint') . Just . head) parts
          (intparts, fracpart) = (filter numeric intparts', filter numeric fracparts')
          separatorpositions = reverse $ map length $ drop 1 intparts
          int = concat $ "":intparts
          frac = concat $ "":fracpart
          precision = length frac
          int' = if null int then "0" else int
          frac' = if null frac then "0" else frac
          sign' = fromMaybe "" sign
          quantity = read $ sign'++int'++"."++frac' -- this read should never fail
          (decimalpoint, separator) = case (decimalpoint', separator') of (Just d,  Just s)   -> (d,s)
                                                                          (Just '.',Nothing)  -> ('.',',')
                                                                          (Just ',',Nothing)  -> (',','.')
                                                                          (Nothing, Just '.') -> (',','.')
                                                                          (Nothing, Just ',') -> ('.',',')
                                                                          _                   -> ('.',',')
      return (quantity,precision,decimalpoint,separator,separatorpositions)
      <?> "number"

    #ifdef TESTS
    test_number = do
          let s `is` n = assertParseEqual' (parseWithCtx nullctx number s) n
              assertFails = assertBool . isLeft . parseWithCtx nullctx number
          assertFails ""
          "0"          `is` (0, 0, '.', ',', [])
          "1"          `is` (1, 0, '.', ',', [])
          "1.1"        `is` (1.1, 1, '.', ',', [])
          "1,000.1"    `is` (1000.1, 1, '.', ',', [3])
          "1.00.000,1" `is` (100000.1, 1, ',', '.', [3,2])
          "1,000,000"  `is` (1000000, 0, '.', ',', [3,3])
          "1."         `is` (1,   0, '.', ',', [])
          "1,"         `is` (1,   0, ',', '.', [])
          ".1"         `is` (0.1, 1, '.', ',', [])
          ",1"         `is` (0.1, 1, ',', '.', [])
          assertFails "1,000.000,1"
          assertFails "1.000,000.1"
          assertFails "1,000.000.1"
          assertFails "1,,1"
          assertFails "1..1"
          assertFails ".1,"
          assertFails ",1."
    #endif

    -- comment parsers

    emptyline :: GenParser Char JournalContext ()
    emptyline = do many spacenonewline
                   optional $ (char ';' <?> "comment") >> many (noneOf "\n")
                   newline
                   return ()

    followingcomment :: GenParser Char JournalContext String
    followingcomment =
      -- ptrace "followingcomment"
      do samelinecomment <- many spacenonewline >> (try commentline <|> (newline >> return ""))
         newlinecomments <- many (try (many1 spacenonewline >> commentline))
         return $ unlines $ samelinecomment:newlinecomments

    commentline :: GenParser Char JournalContext String
    commentline = do
      -- ptrace "commentline"
      char ';'
      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 parseWithCtx nullctx tag s of
                      Right t -> Just t
                      Left _ -> Nothing

    tag = do
      -- ptrace "tag"
      n <- tagname
      v <- tagvalue
      return (n,v)

    tagname = do
      -- ptrace "tagname"
      n <- many1 $ noneOf ": \t"
      char ':'
      return n

    tagvalue = do
      -- ptrace "tagvalue"
      v <- anyChar `manyTill` ((char ',' >> return ()) <|> eolof)
      return $ strip $ reverse $ dropWhile (==',') $ reverse $ strip v

    ledgerDateSyntaxToTags :: String -> String
    ledgerDateSyntaxToTags = regexReplaceBy "\\[[-.\\/0-9=]+\\]" replace
      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++", "

    #ifdef TESTS
    test_ledgerDateSyntaxToTags = do
         assertEqual "date2:2012/11/28, " $ ledgerDateSyntaxToTags "[=2012/11/28]"
    #endif

    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

    {- old hunit tests

    test_Hledger_Read_JournalReader = TestList $ concat [
        test_number,
        test_amountp,
        test_spaceandamountormissing,
        test_tagcomment,
        test_inlinecomment,
        test_commentlines,
        test_ledgerDateSyntaxToTags,
        test_postingp,
        test_transaction,
        [
       "modifiertransaction" ~: do
         assertParse (parseWithCtx nullctx modifiertransaction "= (some value expr)\n some:postings  1\n")

      ,"periodictransaction" ~: do
         assertParse (parseWithCtx nullctx periodictransaction "~ (some period expr)\n some:postings  1\n")

      ,"directive" ~: do
         assertParse (parseWithCtx nullctx directive "!include /some/file.x\n")
         assertParse (parseWithCtx nullctx directive "account some:account\n")
         assertParse (parseWithCtx nullctx (directive >> directive) "!account a\nend\n")

      ,"commentline" ~: do
         assertParse (parseWithCtx nullctx commentline "; some comment \n")
         assertParse (parseWithCtx nullctx commentline " \t; x\n")
         assertParse (parseWithCtx nullctx commentline ";x")

      ,"date" ~: do
         assertParse (parseWithCtx nullctx date "2011/1/1")
         assertParseFailure (parseWithCtx nullctx date "1/1")
         assertParse (parseWithCtx nullctx{ctxYear=Just 2011} date "1/1")

      ,"datetime" ~: do
          let p = do {t <- datetime; eof; return t}
              bad = assertParseFailure . parseWithCtx nullctx p
              good = assertParse . parseWithCtx nullctx p
          bad "2011/1/1"
          bad "2011/1/1 24:00:00"
          bad "2011/1/1 00:60:00"
          bad "2011/1/1 00:00:60"
          good "2011/1/1 00:00"
          good "2011/1/1 23:59:59"
          good "2011/1/1 3:5:7"
          -- timezone is parsed but ignored
          let startofday = LocalTime (fromGregorian 2011 1 1) (TimeOfDay 0 0 (fromIntegral 0))
          assertParseEqual (parseWithCtx nullctx p "2011/1/1 00:00-0800") startofday
          assertParseEqual (parseWithCtx nullctx p "2011/1/1 00:00+1234") startofday

      ,"defaultyeardirective" ~: do
         assertParse (parseWithCtx nullctx defaultyeardirective "Y 2010\n")
         assertParse (parseWithCtx nullctx defaultyeardirective "Y 10001\n")

      ,"historicalpricedirective" ~:
        assertParseEqual (parseWithCtx nullctx historicalpricedirective "P 2004/05/01 XYZ $55.00\n") (HistoricalPrice (parsedate "2004/05/01") "XYZ" $ usd 55)

      ,"ignoredpricecommoditydirective" ~: do
         assertParse (parseWithCtx nullctx ignoredpricecommoditydirective "N $\n")

      ,"defaultcommoditydirective" ~: do
         assertParse (parseWithCtx nullctx defaultcommoditydirective "D $1,000.0\n")

      ,"commodityconversiondirective" ~: do
         assertParse (parseWithCtx nullctx commodityconversiondirective "C 1h = $50.00\n")

      ,"tagdirective" ~: do
         assertParse (parseWithCtx nullctx tagdirective "tag foo \n")

      ,"endtagdirective" ~: do
         assertParse (parseWithCtx nullctx endtagdirective "end tag \n")
         assertParse (parseWithCtx nullctx endtagdirective "pop \n")

      ,"accountname" ~: do
        assertBool "accountname parses a normal accountname" (isRight $ parsewith accountname "a:b:c")
        assertBool "accountname rejects an empty inner component" (isLeft $ parsewith accountname "a::c")
        assertBool "accountname rejects an empty leading component" (isLeft $ parsewith accountname ":b:c")
        assertBool "accountname rejects an empty trailing component" (isLeft $ parsewith accountname "a:b:")

      ,"leftsymbolamount" ~: do
        assertParseEqual (parseWithCtx nullctx leftsymbolamount "$1")  (usd 1 `withPrecision` 0)
        assertParseEqual (parseWithCtx nullctx leftsymbolamount "$-1") (usd (-1) `withPrecision` 0)
        assertParseEqual (parseWithCtx nullctx leftsymbolamount "-$1") (usd (-1) `withPrecision` 0)

      ,"amount" ~: do
         let -- | compare a parse result with an expected amount, showing the debug representation for clarity
             assertAmountParse parseresult amount =
                 (either (const "parse error") showAmountDebug parseresult) ~?= (showAmountDebug amount)
         assertAmountParse (parseWithCtx nullctx amountp "1 @ $2")
           (num 1 `withPrecision` 0 `at` (usd 2 `withPrecision` 0))

     ]]
    -}