journal, lib: the include directive no longer guesses the format

The include directive now tries just one reader, based on the file
extension and defaulting to journal, like the rest of hledger.
(It doesn't yet handle a reader prefix.)

Reader-finding utilities have moved from Hledger.Read to
Hledger.Read.JournalReader so the include directive can use them.

Reader changes:
- rExperimental flag removed
- old rParser renamed to rReadFn
- new rParser field provides the actual parser.
  This seems to require making Reader a higher-kinded type, unfortunately.

hledger-lib/Hledger/Read.hs

@@ -30,7 +30,6 @@ module Hledger.Read (
   readJournalFile,
   requireJournalFileExists,
   ensureJournalFileExists,
-  splitReaderPrefix,
 
   -- * Journal parsing
   readJournal,
@@ -39,6 +38,8 @@ module Hledger.Read (
   -- * Re-exported
   JournalReader.accountaliasp,
   JournalReader.postingp,
+  findReader,
+  splitReaderPrefix,
   module Hledger.Read.Common,
 
   -- * Tests
@@ -70,10 +71,10 @@ import Text.Printf
 import Hledger.Data.Dates (getCurrentDay, parsedate, showDate)
 import Hledger.Data.Types
 import Hledger.Read.Common
-import Hledger.Read.JournalReader   as JournalReader
-import qualified Hledger.Read.TimedotReader   as TimedotReader
-import qualified Hledger.Read.TimeclockReader as TimeclockReader
-import Hledger.Read.CsvReader as CsvReader
+import Hledger.Read.JournalReader as JournalReader
+import Hledger.Read.CsvReader (tests_CsvReader)
+-- import Hledger.Read.TimedotReader (tests_TimedotReader)
+-- import Hledger.Read.TimeclockReader (tests_TimeclockReader)
 import Hledger.Utils
 import Prelude hiding (getContents, writeFile)
 
@@ -85,19 +86,6 @@ journalDefaultFilename  = ".hledger.journal"
 
 -- ** journal reading
 
--- The available journal readers, each one handling a particular data format.
-readers :: [Reader]
-readers = [
-  JournalReader.reader
- ,TimeclockReader.reader
- ,TimedotReader.reader
- ,CsvReader.reader
---  ,LedgerReader.reader
- ]
-
-readerNames :: [String]
-readerNames = map rFormat readers
-
 -- | Read a Journal from the given text, assuming journal format; or
 -- throw an error.
 readJournal' :: Text -> IO Journal
@@ -120,28 +108,10 @@ readJournal' t = readJournal def Nothing t >>= either error' return
 -- since hledger 1.17, we prefer predictability.)
 readJournal :: InputOpts -> Maybe FilePath -> Text -> IO (Either String Journal)
 readJournal iopts mpath txt = do
+  let r :: Reader IO =
+        fromMaybe JournalReader.reader $ findReader (mformat_ iopts) mpath
   dbg1IO "trying reader" (rFormat r)
-  ej <- (runExceptT . (rParser r) iopts (fromMaybe "(string)" mpath)) txt
-  dbg1IO "reader result" (' ':show ej)
-  return ej
-  where
-    r = fromMaybe JournalReader.reader $ findReader (mformat_ iopts) mpath
-
--- | @findReader mformat mpath@
---
--- Find the reader named by @mformat@, if provided.
--- Or, if a file path is provided, find the first reader that handles
--- its file extension, if any.
-findReader :: Maybe StorageFormat -> Maybe FilePath -> Maybe Reader
-findReader Nothing Nothing     = Nothing
-findReader (Just fmt) _        = headMay [r | r <- readers, rFormat r == fmt]
-findReader Nothing (Just path) =
-  case prefix of
-    Just fmt -> headMay [r | r <- readers, rFormat r == fmt]
-    Nothing  -> headMay [r | r <- readers, ext `elem` rExtensions r]
-  where
-    (prefix,path') = splitReaderPrefix path
-    ext            = drop 1 $ takeExtension path'
+  (runExceptT . (rReadFn r) iopts (fromMaybe "(string)" mpath)) txt
 
 -- | Read the default journal file specified by the environment, or raise an error.
 defaultJournal :: IO Journal
@@ -218,13 +188,6 @@ readJournalFile iopts prefixedfile = do
 
 -- ** utilities
 
--- | If a filepath is prefixed by one of the reader names and a colon,
--- split that off. Eg "csv:-" -> (Just "csv", "-").
-splitReaderPrefix :: PrefixedFilePath -> (Maybe String, FilePath)
-splitReaderPrefix f =
-  headDef (Nothing, f)
-  [(Just r, drop (length r + 1) f) | r <- readerNames, (r++":") `isPrefixOf` f]
-
 -- | If the specified journal file does not exist (and is not "-"),
 -- give a helpful error and quit.
 requireJournalFileExists :: FilePath -> IO ()

hledger-lib/Hledger/Read/Common.hs

@@ -21,6 +21,7 @@ Some of these might belong in Hledger.Read.JournalReader or Hledger.Read.
 {-# LANGUAGE NoMonoLocalBinds #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE PackageImports #-}
+{-# LANGUAGE Rank2Types #-}
 {-# LANGUAGE RecordWildCards #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE TupleSections #-}
@@ -150,7 +151,9 @@ import Hledger.Utils
 
 -- | A hledger journal reader is a triple of storage format name, a
 -- detector of that format, and a parser from that format to Journal.
-data Reader = Reader {
+-- The type variable m appears here so that rParserr can hold a
+-- journal parser, which depends on it.
+data Reader m = Reader {
 
      -- The canonical name of the format handled by this reader
      rFormat   :: StorageFormat
@@ -158,16 +161,17 @@ data Reader = Reader {
      -- The file extensions recognised as containing this format
     ,rExtensions :: [String]
 
-     -- A text parser for this format, accepting input options, file
+     -- The entry point for reading this format, accepting input options, file
      -- path for error messages and file contents, producing an exception-raising IO
-     -- action that returns a journal or error message.
-    ,rParser   :: InputOpts -> FilePath -> Text -> ExceptT String IO Journal
+     -- action that produces a journal or error message.
+    ,rReadFn   :: InputOpts -> FilePath -> Text -> ExceptT String IO Journal
 
-     -- Experimental readers are never tried automatically.
-    ,rExperimental :: Bool
+     -- The actual megaparsec parser called by the above, in case
+     -- another parser (includedirectivep) wants to use it directly.
+    ,rParser :: MonadIO m => ErroringJournalParser m ParsedJournal
     }
 
-instance Show Reader where show r = rFormat r ++ " reader"
+instance Show (Reader m) where show r = rFormat r ++ " reader"
 
 -- $setup
 
@@ -570,6 +574,7 @@ accountnamep = singlespacedtextp
 
 -- | Parse any text beginning with a non-whitespace character, until a
 -- double space or the end of input.
+-- TODO including characters which normally start a comment (;#) - exclude those ? 
 singlespacedtextp :: TextParser m T.Text
 singlespacedtextp = singlespacedtextsatisfyingp (const True)
 

hledger-lib/Hledger/Read/CsvReader.hs

@@ -50,7 +50,7 @@ import qualified "base-compat-batteries" Control.Monad.Fail.Compat as Fail (fail
 import Control.Exception          (IOException, handle, throw)
 import Control.Monad              (liftM, unless, when)
 import Control.Monad.Except       (ExceptT, throwError)
-import Control.Monad.IO.Class     (liftIO)
+import Control.Monad.IO.Class     (MonadIO, liftIO)
 import Control.Monad.State.Strict (StateT, get, modify', evalStateT)
 import Control.Monad.Trans.Class  (lift)
 import Data.Char                  (toLower, isDigit, isSpace, ord)
@@ -95,12 +95,12 @@ type CsvValue  = String
 
 -- ** reader
 
-reader :: Reader
+reader :: MonadIO m => Reader m
 reader = Reader
   {rFormat     = "csv"
   ,rExtensions = ["csv","tsv","ssv"]
-  ,rParser     = parse
-  ,rExperimental = False
+  ,rReadFn     = parse
+  ,rParser    = error' "sorry, CSV files can't be included yet"
   }
 
 -- | Parse and post-process a "Journal" from CSV data, or give an error.

hledger-lib/Hledger/Read/JournalReader.hs

@@ -43,6 +43,10 @@ Hledger.Read.Common, to avoid import cycles.
 -- ** exports
 module Hledger.Read.JournalReader (
 
+  -- * Reader-finding utils
+  findReader,
+  splitReaderPrefix,
+  
   -- * Reader
   reader,
 
@@ -89,6 +93,7 @@ import Data.Monoid ((<>))
 import Data.Text (Text)
 import Data.String
 import Data.List
+import Data.Maybe
 import qualified Data.Text as T
 import Data.Time.Calendar
 import Data.Time.LocalTime
@@ -102,18 +107,64 @@ import "Glob" System.FilePath.Glob hiding (match)
 
 import Hledger.Data
 import Hledger.Read.Common
-import Hledger.Read.TimeclockReader (timeclockfilep)
-import Hledger.Read.TimedotReader (timedotfilep)
 import Hledger.Utils
 
+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
+-- 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.
+readers' :: MonadIO m => [Reader m]
+readers' = [
+  reader
+ ,TimeclockReader.reader
+ ,TimedotReader.reader
+ ,CsvReader.reader
+--  ,LedgerReader.reader
+ ]
+
+readerNames :: [String]
+readerNames = map rFormat (readers'::[Reader IO])
+
+-- | @findReader mformat mpath@
+--
+-- Find the reader named by @mformat@, if provided.
+-- Or, if a file path is provided, find the first reader that handles
+-- its file extension, if any.
+findReader :: MonadIO m => Maybe StorageFormat -> Maybe FilePath -> Maybe (Reader m)
+findReader Nothing Nothing     = Nothing
+findReader (Just fmt) _        = headMay [r | r <- readers', rFormat r == fmt]
+findReader Nothing (Just path) =
+  case prefix of
+    Just fmt -> headMay [r | r <- readers', rFormat r == fmt]
+    Nothing  -> headMay [r | r <- readers', ext `elem` rExtensions r]
+  where
+    (prefix,path') = splitReaderPrefix path
+    ext            = drop 1 $ takeExtension path'
+
+-- | A file path optionally prefixed by a reader name and colon
+-- (journal:, csv:, timedot:, etc.).
+type PrefixedFilePath = FilePath
+
+-- | If a filepath is prefixed by one of the reader names and a colon,
+-- split that off. Eg "csv:-" -> (Just "csv", "-").
+splitReaderPrefix :: PrefixedFilePath -> (Maybe String, FilePath)
+splitReaderPrefix f =
+  headDef (Nothing, f)
+  [(Just r, drop (length r + 1) f) | r <- readerNames, (r++":") `isPrefixOf` f]
+
 -- ** reader
 
-reader :: Reader
+reader :: MonadIO m => Reader m
 reader = Reader
   {rFormat     = "journal"
   ,rExtensions = ["journal", "j", "hledger", "ledger"]
-  ,rParser     = parse
-  ,rExperimental = False
+  ,rReadFn     = parse
+  ,rParser    = journalp  -- no need to add command line aliases like journalp'
+                           -- when called as a subparser I think
   }
 
 -- | Parse and post-process a "Journal" from hledger's journal file
@@ -234,11 +285,11 @@ includedirectivep = do
                             `orRethrowIOError` (show parentpos ++ " reading " ++ filepath)
       let initChildj = newJournalWithParseStateFrom filepath parentj
 
-      let parser = choiceInState
-            [ journalp
-            , timeclockfilep
-            , timedotfilep
-            ] -- can't include a csv file yet, that reader is special
+      -- Choose a reader/format based on the file path, or fall back
+      -- on journal. Duplicating readJournal a bit here.
+      let r = fromMaybe reader $ findReader Nothing (Just filepath)
+          parser = rParser r
+      dbg1IO "trying reader" (rFormat r)
       updatedChildj <- journalAddFile (filepath, childInput) <$>
                         parseIncludeFile parser initChildj filepath childInput
 

hledger-lib/Hledger/Read/TimeclockReader.hs

@@ -78,12 +78,12 @@ import           Hledger.Utils
 
 -- ** reader
 
-reader :: Reader
+reader :: MonadIO m => Reader m
 reader = Reader
   {rFormat     = "timeclock"
   ,rExtensions = ["timeclock"]
-  ,rParser     = parse
-  ,rExperimental = False
+  ,rReadFn     = parse
+  ,rParser    = timeclockfilep
   }
 
 -- | Parse and post-process a "Journal" from timeclock.el's timeclock

hledger-lib/Hledger/Read/TimedotReader.hs

@@ -63,12 +63,12 @@ import Hledger.Utils
 
 -- ** reader
 
-reader :: Reader
+reader :: MonadIO m => Reader m
 reader = Reader
   {rFormat     = "timedot"
   ,rExtensions = ["timedot"]
-  ,rParser     = parse
-  ,rExperimental = False
+  ,rReadFn     = parse
+  ,rParser    = timedotp
   }
 
 -- | Parse and post-process a "Journal" from the timedot format, or give an error.