mirror of
https://github.com/simonmichael/hledger.git
synced 2024-12-25 19:31:44 +03:00
;lib: fix org headings and doctest setup that were breaking haddock
(and in some cases, installation). [ci skip]
This commit is contained in:
parent
db877d7355
commit
374be00223
@ -1,5 +1,5 @@
|
||||
-- * -*- eval: (orgstruct-mode 1); orgstruct-heading-prefix-regexp:"-- "; -*-
|
||||
-- ** doc
|
||||
--- * -*- eval: (orgstruct-mode 1); orgstruct-heading-prefix-regexp:"--- "; -*-
|
||||
--- ** doc
|
||||
-- In Emacs, use TAB on lines beginning with "-- *" to collapse/expand sections.
|
||||
{-|
|
||||
|
||||
@ -10,16 +10,12 @@ to import modules below this one.
|
||||
|
||||
-}
|
||||
|
||||
-- ** language
|
||||
--- ** language
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE PackageImports #-}
|
||||
{-# LANGUAGE ScopedTypeVariables #-}
|
||||
|
||||
-- ** doctest setup
|
||||
-- $setup
|
||||
-- >>> :set -XOverloadedStrings
|
||||
|
||||
-- ** exports
|
||||
--- ** exports
|
||||
module Hledger.Read (
|
||||
|
||||
-- * Journal files
|
||||
@ -47,7 +43,7 @@ module Hledger.Read (
|
||||
|
||||
) where
|
||||
|
||||
-- ** imports
|
||||
--- ** imports
|
||||
import Control.Arrow (right)
|
||||
import qualified Control.Exception as C
|
||||
import Control.Monad (when)
|
||||
@ -78,14 +74,16 @@ import Hledger.Read.CsvReader (tests_CsvReader)
|
||||
import Hledger.Utils
|
||||
import Prelude hiding (getContents, writeFile)
|
||||
|
||||
-- ** environment
|
||||
--- ** doctest setup
|
||||
-- $setup
|
||||
-- >>> :set -XOverloadedStrings
|
||||
|
||||
--- ** journal reading
|
||||
|
||||
journalEnvVar = "LEDGER_FILE"
|
||||
journalEnvVar2 = "LEDGER"
|
||||
journalDefaultFilename = ".hledger.journal"
|
||||
|
||||
-- ** journal reading
|
||||
|
||||
-- | Read a Journal from the given text, assuming journal format; or
|
||||
-- throw an error.
|
||||
readJournal' :: Text -> IO Journal
|
||||
@ -186,7 +184,7 @@ readJournalFile iopts prefixedfile = do
|
||||
return $ Right newj
|
||||
Right j -> return $ Right j
|
||||
|
||||
-- ** utilities
|
||||
--- ** utilities
|
||||
|
||||
-- | If the specified journal file does not exist (and is not "-"),
|
||||
-- give a helpful error and quit.
|
||||
@ -285,7 +283,7 @@ journalFilterSinceLatestDates ds@(d:_) j = (j', ds')
|
||||
j' = j{jtxns=newsamedatets++laterts}
|
||||
ds' = latestDates $ map tdate $ samedatets++laterts
|
||||
|
||||
-- ** tests
|
||||
--- ** tests
|
||||
|
||||
tests_Read = tests "Read" [
|
||||
tests_Common
|
||||
|
@ -1,5 +1,5 @@
|
||||
-- * -*- eval: (orgstruct-mode 1); orgstruct-heading-prefix-regexp:"-- "; -*-
|
||||
-- ** doc
|
||||
--- * -*- eval: (orgstruct-mode 1); orgstruct-heading-prefix-regexp:"--- "; -*-
|
||||
--- ** doc
|
||||
-- In Emacs, use TAB on lines beginning with "-- *" to collapse/expand sections.
|
||||
{-|
|
||||
|
||||
@ -11,7 +11,7 @@ Some of these might belong in Hledger.Read.JournalReader or Hledger.Read.
|
||||
|
||||
-}
|
||||
|
||||
-- ** language
|
||||
--- ** language
|
||||
{-# LANGUAGE BangPatterns #-}
|
||||
{-# LANGUAGE CPP #-}
|
||||
{-# LANGUAGE DeriveDataTypeable #-}
|
||||
@ -27,11 +27,7 @@ Some of these might belong in Hledger.Read.JournalReader or Hledger.Read.
|
||||
{-# LANGUAGE TupleSections #-}
|
||||
{-# LANGUAGE TypeFamilies #-}
|
||||
|
||||
-- ** doctest setup
|
||||
-- $setup
|
||||
-- >>> :set -XOverloadedStrings
|
||||
|
||||
-- ** exports
|
||||
--- ** exports
|
||||
module Hledger.Read.Common (
|
||||
Reader (..),
|
||||
InputOpts (..),
|
||||
@ -114,7 +110,7 @@ module Hledger.Read.Common (
|
||||
)
|
||||
where
|
||||
|
||||
-- ** imports
|
||||
--- ** imports
|
||||
import Prelude ()
|
||||
import "base-compat-batteries" Prelude.Compat hiding (fail, readFile)
|
||||
import qualified "base-compat-batteries" Control.Monad.Fail.Compat as Fail (fail)
|
||||
@ -145,7 +141,11 @@ import Text.Megaparsec.Custom
|
||||
import Hledger.Data
|
||||
import Hledger.Utils
|
||||
|
||||
-- ** types
|
||||
--- ** doctest setup
|
||||
-- $setup
|
||||
-- >>> :set -XOverloadedStrings
|
||||
|
||||
--- ** types
|
||||
|
||||
-- main types; a few more below
|
||||
|
||||
@ -210,7 +210,7 @@ rawOptsToInputOpts rawopts = InputOpts{
|
||||
,auto_ = boolopt "auto" rawopts
|
||||
}
|
||||
|
||||
-- ** parsing utilities
|
||||
--- ** parsing utilities
|
||||
|
||||
-- | Run a text parser in the identity monad. See also: parseWithState.
|
||||
runTextParser, rtp
|
||||
@ -401,8 +401,8 @@ match' p = do
|
||||
(!txt, p) <- match p
|
||||
pure (txt, p)
|
||||
|
||||
-- ** parsers
|
||||
-- *** transaction bits
|
||||
--- ** parsers
|
||||
--- *** transaction bits
|
||||
|
||||
statusp :: TextParser m Status
|
||||
statusp =
|
||||
@ -425,7 +425,7 @@ descriptionp :: TextParser m Text
|
||||
descriptionp = takeWhileP Nothing (not . semicolonOrNewline)
|
||||
where semicolonOrNewline c = c == ';' || c == '\n'
|
||||
|
||||
-- *** dates
|
||||
--- *** dates
|
||||
|
||||
-- | Parse a date in YYYY-MM-DD format.
|
||||
-- Slash (/) and period (.) are also allowed as separators.
|
||||
@ -543,7 +543,7 @@ secondarydatep :: Day -> TextParser m Day
|
||||
secondarydatep primaryDate = char '=' *> datep' (Just primaryYear)
|
||||
where primaryYear = first3 $ toGregorian primaryDate
|
||||
|
||||
-- *** account names
|
||||
--- *** account names
|
||||
|
||||
-- | Parse an account name (plus one following space if present),
|
||||
-- then apply any parent account prefix and/or account aliases currently in effect,
|
||||
@ -592,7 +592,7 @@ singlespacedtextsatisfyingp pred = do
|
||||
singlespacep :: TextParser m ()
|
||||
singlespacep = void spacenonewline *> notFollowedBy spacenonewline
|
||||
|
||||
-- *** amounts
|
||||
--- *** amounts
|
||||
|
||||
-- | Parse whitespace then an amount, with an optional left or right
|
||||
-- currency symbol and optional price, or return the special
|
||||
@ -995,7 +995,7 @@ digitgroupp = label "digits"
|
||||
makeGroup = uncurry DigitGrp . foldl' step (0, 0) . T.unpack
|
||||
step (!l, !a) c = (l+1, a*10 + fromIntegral (digitToInt c))
|
||||
|
||||
-- *** comments
|
||||
--- *** comments
|
||||
|
||||
multilinecommentp :: TextParser m ()
|
||||
multilinecommentp = startComment *> anyLine `skipManyTill` endComment
|
||||
@ -1302,7 +1302,7 @@ bracketeddatetagsp mYear1 = do
|
||||
|
||||
{-# INLINABLE bracketeddatetagsp #-}
|
||||
|
||||
-- ** tests
|
||||
--- ** tests
|
||||
|
||||
tests_Common = tests "Common" [
|
||||
|
||||
|
@ -1,5 +1,5 @@
|
||||
-- * -*- eval: (orgstruct-mode 1); orgstruct-heading-prefix-regexp:"-- "; -*-
|
||||
-- ** doc
|
||||
--- * -*- eval: (orgstruct-mode 1); orgstruct-heading-prefix-regexp:"--- "; -*-
|
||||
--- ** doc
|
||||
-- In Emacs, use TAB on lines beginning with "-- *" to collapse/expand sections.
|
||||
{-|
|
||||
|
||||
@ -10,7 +10,7 @@ A reader for CSV data, using an extra rules file to help interpret the data.
|
||||
-- Here's a command that will render them:
|
||||
-- stack haddock hledger-lib --fast --no-haddock-deps --haddock-arguments='--ignore-all-exports' --open
|
||||
|
||||
-- ** language
|
||||
--- ** language
|
||||
{-# LANGUAGE CPP #-}
|
||||
{-# LANGUAGE FlexibleContexts #-}
|
||||
{-# LANGUAGE FlexibleInstances #-}
|
||||
@ -24,11 +24,7 @@ A reader for CSV data, using an extra rules file to help interpret the data.
|
||||
{-# LANGUAGE TypeSynonymInstances #-}
|
||||
{-# LANGUAGE ViewPatterns #-}
|
||||
|
||||
-- ** doctest setup
|
||||
-- $setup
|
||||
-- >>> :set -XOverloadedStrings
|
||||
|
||||
-- ** exports
|
||||
--- ** exports
|
||||
module Hledger.Read.CsvReader (
|
||||
-- * Reader
|
||||
reader,
|
||||
@ -43,7 +39,7 @@ module Hledger.Read.CsvReader (
|
||||
)
|
||||
where
|
||||
|
||||
-- ** imports
|
||||
--- ** imports
|
||||
import Prelude ()
|
||||
import "base-compat-batteries" Prelude.Compat hiding (fail)
|
||||
import qualified "base-compat-batteries" Control.Monad.Fail.Compat as Fail (fail)
|
||||
@ -87,13 +83,17 @@ import Hledger.Data
|
||||
import Hledger.Utils
|
||||
import Hledger.Read.Common (Reader(..),InputOpts(..),amountp, statusp, genericSourcePos, finaliseJournal)
|
||||
|
||||
-- ** some types
|
||||
--- ** doctest setup
|
||||
-- $setup
|
||||
-- >>> :set -XOverloadedStrings
|
||||
|
||||
--- ** some types
|
||||
|
||||
type CSV = [CsvRecord]
|
||||
type CsvRecord = [CsvValue]
|
||||
type CsvValue = String
|
||||
|
||||
-- ** reader
|
||||
--- ** reader
|
||||
|
||||
reader :: MonadIO m => Reader m
|
||||
reader = Reader
|
||||
@ -119,8 +119,8 @@ parse iopts f t = do
|
||||
-- better preemptively reverse them once more. XXX inefficient
|
||||
pj' = journalReverse pj
|
||||
|
||||
-- ** reading rules files
|
||||
-- *** rules utilities
|
||||
--- ** reading rules files
|
||||
--- *** rules utilities
|
||||
|
||||
-- Not used by hledger; just for lib users,
|
||||
-- | An pure-exception-throwing IO action that parses this file's content
|
||||
@ -232,7 +232,7 @@ validateRules rules = do
|
||||
where
|
||||
isAssigned f = isJust $ getEffectiveAssignment rules [] f
|
||||
|
||||
-- *** rules types
|
||||
--- *** rules types
|
||||
|
||||
-- | A set of data definitions and account-matching patterns sufficient to
|
||||
-- convert a particular CSV data file into meaningful journal transactions.
|
||||
@ -300,7 +300,7 @@ defrules = CsvRules {
|
||||
rconditionalblocks=[]
|
||||
}
|
||||
|
||||
-- *** rules parsers
|
||||
--- *** rules parsers
|
||||
|
||||
{-
|
||||
Grammar for the CSV conversion rules, more or less:
|
||||
@ -573,7 +573,7 @@ regexp = do
|
||||
-- -- ,"!="
|
||||
-- ]
|
||||
|
||||
-- ** reading csv files
|
||||
--- ** reading csv files
|
||||
|
||||
-- | Read a Journal from the given CSV data (and filename, used for error
|
||||
-- messages), or return an error. Proceed as follows:
|
||||
@ -748,7 +748,7 @@ validateCsv rules numhdrlines (Right rs) = validate $ applyConditionalSkips $ dr
|
||||
-- ,date2Field r
|
||||
-- ]
|
||||
|
||||
-- ** converting csv records to transactions
|
||||
--- ** converting csv records to transactions
|
||||
|
||||
showRules rules record =
|
||||
unlines $ catMaybes [ (("the "++fld++" rule is: ")++) <$> getEffectiveAssignment rules record fld | fld <- journalfieldnames]
|
||||
@ -1174,7 +1174,7 @@ parseDateWithCustomOrDefaultFormats mformat s = firstJust $ map parsewith format
|
||||
(:[])
|
||||
mformat
|
||||
|
||||
-- ** tests
|
||||
--- ** tests
|
||||
|
||||
tests_CsvReader = tests "CsvReader" [
|
||||
tests "parseCsvRules" [
|
||||
|
@ -1,5 +1,5 @@
|
||||
-- * -*- eval: (orgstruct-mode 1); orgstruct-heading-prefix-regexp:"-- "; -*-
|
||||
-- ** doc
|
||||
--- * -*- eval: (orgstruct-mode 1); orgstruct-heading-prefix-regexp:"--- "; -*-
|
||||
--- ** doc
|
||||
-- In Emacs, use TAB on lines beginning with "-- *" to collapse/expand sections.
|
||||
{-|
|
||||
|
||||
@ -24,7 +24,7 @@ Hledger.Read.Common, to avoid import cycles.
|
||||
|
||||
-}
|
||||
|
||||
-- ** language
|
||||
--- ** language
|
||||
|
||||
{-# LANGUAGE CPP #-}
|
||||
{-# LANGUAGE FlexibleContexts #-}
|
||||
@ -36,11 +36,7 @@ Hledger.Read.Common, to avoid import cycles.
|
||||
{-# LANGUAGE ScopedTypeVariables #-}
|
||||
{-# LANGUAGE TupleSections #-}
|
||||
|
||||
-- ** doctest setup
|
||||
-- $setup
|
||||
-- >>> :set -XOverloadedStrings
|
||||
|
||||
-- ** exports
|
||||
--- ** exports
|
||||
module Hledger.Read.JournalReader (
|
||||
|
||||
-- * Reader-finding utils
|
||||
@ -76,7 +72,7 @@ module Hledger.Read.JournalReader (
|
||||
)
|
||||
where
|
||||
|
||||
-- ** imports
|
||||
--- ** imports
|
||||
-- import qualified Prelude (fail)
|
||||
-- import "base-compat-batteries" Prelude.Compat hiding (fail, readFile)
|
||||
import qualified "base-compat-batteries" Control.Monad.Fail.Compat as Fail (fail)
|
||||
@ -113,7 +109,11 @@ import qualified Hledger.Read.TimedotReader as TimedotReader (reader)
|
||||
import qualified Hledger.Read.TimeclockReader as TimeclockReader (reader)
|
||||
import qualified Hledger.Read.CsvReader as CsvReader (reader)
|
||||
|
||||
-- ** reader finding utilities
|
||||
--- ** doctest setup
|
||||
-- $setup
|
||||
-- >>> :set -XOverloadedStrings
|
||||
|
||||
--- ** reader finding utilities
|
||||
-- Defined here rather than Hledger.Read so that we can use them in includedirectivep below.
|
||||
|
||||
-- The available journal readers, each one handling a particular data format.
|
||||
@ -156,7 +156,7 @@ splitReaderPrefix f =
|
||||
headDef (Nothing, f)
|
||||
[(Just r, drop (length r + 1) f) | r <- readerNames, (r++":") `isPrefixOf` f]
|
||||
|
||||
-- ** reader
|
||||
--- ** reader
|
||||
|
||||
reader :: MonadIO m => Reader m
|
||||
reader = Reader
|
||||
@ -182,8 +182,8 @@ aliasesFromOpts :: InputOpts -> [AccountAlias]
|
||||
aliasesFromOpts = map (\a -> fromparse $ runParser accountaliasp ("--alias "++quoteIfNeeded a) $ T.pack a)
|
||||
. aliases_
|
||||
|
||||
-- ** parsers
|
||||
-- *** journal
|
||||
--- ** parsers
|
||||
--- *** journal
|
||||
|
||||
-- | A journal parser. Accumulates and returns a "ParsedJournal",
|
||||
-- which should be finalised/validated before use.
|
||||
@ -213,7 +213,7 @@ addJournalItemP =
|
||||
, void (lift multilinecommentp)
|
||||
] <?> "transaction or directive"
|
||||
|
||||
-- *** directives
|
||||
--- *** directives
|
||||
|
||||
-- | Parse any journal directive and update the parse state accordingly.
|
||||
-- Cf http://hledger.org/manual.html#directives,
|
||||
@ -583,7 +583,7 @@ commodityconversiondirectivep = do
|
||||
lift restofline
|
||||
return ()
|
||||
|
||||
-- *** transactions
|
||||
--- *** transactions
|
||||
|
||||
-- | Parse a transaction modifier (auto postings) rule.
|
||||
transactionmodifierp :: JournalParser m TransactionModifier
|
||||
@ -680,7 +680,7 @@ transactionp = do
|
||||
let sourcepos = journalSourcePos startpos endpos
|
||||
return $ txnTieKnot $ Transaction 0 "" sourcepos date edate status code description comment tags postings
|
||||
|
||||
-- *** postings
|
||||
--- *** postings
|
||||
|
||||
-- Parse the following whitespace-beginning lines as postings, posting
|
||||
-- tags, and/or comments (inferring year, if needed, from the given date).
|
||||
@ -723,7 +723,7 @@ postingp mTransactionYear = do
|
||||
, pbalanceassertion=massertion
|
||||
}
|
||||
|
||||
-- ** tests
|
||||
--- ** tests
|
||||
|
||||
tests_JournalReader = tests "JournalReader" [
|
||||
|
||||
|
@ -1,5 +1,5 @@
|
||||
-- * -*- eval: (orgstruct-mode 1); orgstruct-heading-prefix-regexp:"-- "; -*-
|
||||
-- ** doc
|
||||
--- * -*- eval: (orgstruct-mode 1); orgstruct-heading-prefix-regexp:"--- "; -*-
|
||||
--- ** doc
|
||||
-- In Emacs, use TAB on lines beginning with "-- *" to collapse/expand sections.
|
||||
{-|
|
||||
|
||||
@ -43,15 +43,11 @@ i, o or O. The meanings of the codes are:
|
||||
|
||||
-}
|
||||
|
||||
-- ** language
|
||||
--- ** language
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE PackageImports #-}
|
||||
|
||||
-- ** doctest setup
|
||||
-- $setup
|
||||
-- >>> :set -XOverloadedStrings
|
||||
|
||||
-- ** exports
|
||||
--- ** exports
|
||||
module Hledger.Read.TimeclockReader (
|
||||
-- * Reader
|
||||
reader,
|
||||
@ -60,7 +56,7 @@ module Hledger.Read.TimeclockReader (
|
||||
)
|
||||
where
|
||||
|
||||
-- ** imports
|
||||
--- ** imports
|
||||
import Prelude ()
|
||||
import "base-compat-batteries" Prelude.Compat
|
||||
import Control.Monad
|
||||
@ -76,7 +72,11 @@ import Hledger.Data
|
||||
import Hledger.Read.Common
|
||||
import Hledger.Utils
|
||||
|
||||
-- ** reader
|
||||
--- ** doctest setup
|
||||
-- $setup
|
||||
-- >>> :set -XOverloadedStrings
|
||||
|
||||
--- ** reader
|
||||
|
||||
reader :: MonadIO m => Reader m
|
||||
reader = Reader
|
||||
@ -92,7 +92,7 @@ reader = Reader
|
||||
parse :: InputOpts -> FilePath -> Text -> ExceptT String IO Journal
|
||||
parse = parseAndFinaliseJournal' timeclockfilep
|
||||
|
||||
-- ** parsers
|
||||
--- ** parsers
|
||||
|
||||
timeclockfilep :: MonadIO m => JournalParser m ParsedJournal
|
||||
timeclockfilep = do many timeclockitemp
|
||||
|
@ -1,5 +1,5 @@
|
||||
-- * -*- eval: (orgstruct-mode 1); orgstruct-heading-prefix-regexp:"-- "; -*-
|
||||
-- ** doc
|
||||
--- * -*- eval: (orgstruct-mode 1); orgstruct-heading-prefix-regexp:"--- "; -*-
|
||||
--- ** doc
|
||||
-- In Emacs, use TAB on lines beginning with "-- *" to collapse/expand sections.
|
||||
{-|
|
||||
|
||||
@ -26,15 +26,11 @@ inc.client1 .... .... ..
|
||||
|
||||
-}
|
||||
|
||||
-- ** language
|
||||
--- ** language
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE PackageImports #-}
|
||||
|
||||
-- ** doctest setup
|
||||
-- $setup
|
||||
-- >>> :set -XOverloadedStrings
|
||||
|
||||
-- ** exports
|
||||
--- ** exports
|
||||
module Hledger.Read.TimedotReader (
|
||||
-- * Reader
|
||||
reader,
|
||||
@ -43,7 +39,7 @@ module Hledger.Read.TimedotReader (
|
||||
)
|
||||
where
|
||||
|
||||
-- ** imports
|
||||
--- ** imports
|
||||
import Prelude ()
|
||||
import "base-compat-batteries" Prelude.Compat
|
||||
import Control.Monad
|
||||
@ -61,7 +57,11 @@ import Hledger.Data
|
||||
import Hledger.Read.Common hiding (emptyorcommentlinep)
|
||||
import Hledger.Utils
|
||||
|
||||
-- ** reader
|
||||
--- ** doctest setup
|
||||
-- $setup
|
||||
-- >>> :set -XOverloadedStrings
|
||||
|
||||
--- ** reader
|
||||
|
||||
reader :: MonadIO m => Reader m
|
||||
reader = Reader
|
||||
@ -75,7 +75,7 @@ reader = Reader
|
||||
parse :: InputOpts -> FilePath -> Text -> ExceptT String IO Journal
|
||||
parse = parseAndFinaliseJournal' timedotp
|
||||
|
||||
-- ** utilities
|
||||
--- ** utilities
|
||||
|
||||
traceparse, traceparse' :: String -> TextParser m ()
|
||||
traceparse = const $ return ()
|
||||
@ -84,7 +84,7 @@ traceparse' = const $ return ()
|
||||
-- traceparse s = traceParse (s++"?")
|
||||
-- traceparse' s = trace s $ return ()
|
||||
|
||||
-- ** parsers
|
||||
--- ** parsers
|
||||
{-
|
||||
Rough grammar for timedot format:
|
||||
|
||||
|
Loading…
Reference in New Issue
Block a user