lib/Hcompta/Format/Ledger/Read.hs

   1 {-# LANGUAGE FlexibleContexts #-}
   2 {-# LANGUAGE NamedFieldPuns #-}
   3 {-# LANGUAGE OverloadedStrings #-}
   4 {-# LANGUAGE ScopedTypeVariables #-}
   5 {-# LANGUAGE TupleSections #-}
   6 {-# LANGUAGE TypeFamilies #-}
   7 module Hcompta.Format.Ledger.Read where
   8
   9 -- import           Control.Applicative ((<$>), (<*>), (<*))
  10 import           Control.Arrow ((***), first)
  11 import qualified Control.Exception as Exception
  12 import           Control.Monad (guard, liftM, join, forM, void)
  13 import           Control.Monad.IO.Class (liftIO)
  14 import           Control.Monad.Trans.Except (ExceptT(..), throwE)
  15 import qualified Data.Char
  16 import qualified Data.Either
  17 import qualified Data.List
  18 import qualified Data.List.NonEmpty as NonEmpty
  19 import           Data.List.NonEmpty (NonEmpty(..))
  20 import qualified Data.Map.Strict as Data.Map
  21 import           Data.Map.Strict (Map)
  22 import           Data.Maybe (fromMaybe)
  23 import           Data.String (fromString)
  24 import qualified Data.Text as Text
  25 import qualified Data.Time.Calendar  as Time
  26 import qualified Data.Time.Clock     as Time
  27 import qualified Data.Time.LocalTime as Time
  28 import           Data.Typeable ()
  29 import qualified Text.Parsec as R hiding
  30                   ( char
  31                   , anyChar
  32                   , crlf
  33                   , newline
  34                   , noneOf
  35                   , oneOf
  36                   , satisfy
  37                   , space
  38                   , spaces
  39                   , string
  40                   , tab
  41                   )
  42 import           Text.Parsec (Stream, ParsecT, (<|>), (<?>))
  43 import qualified Text.Parsec.Pos as R
  44 import qualified Data.Text.IO as Text.IO (readFile)
  45 import qualified System.FilePath.Posix as Path
  46
  47 import qualified Hcompta.Account as Account
  48 import           Hcompta.Account (Account)
  49 import qualified Hcompta.Account.Read as Account.Read
  50 import qualified Hcompta.Balance as Balance
  51 import qualified Hcompta.Amount as Amount
  52 import qualified Hcompta.Amount.Style as Style
  53 import qualified Hcompta.Amount.Read as Amount.Read
  54 import qualified Hcompta.Amount.Unit as Unit
  55 import qualified Hcompta.Date as Date
  56 import           Hcompta.Date (Date)
  57 import qualified Hcompta.Date.Read as Date.Read
  58 import qualified Hcompta.Format.Ledger as Ledger
  59 import           Hcompta.Posting as Posting
  60 import           Hcompta.Format.Ledger
  61                   ( Comment
  62                   , Journal(..)
  63                   , Posting(..)
  64                   , Transaction(..)
  65                   )
  66 import           Hcompta.Lib.Consable (Consable(..))
  67 import           Hcompta.Lib.Regex (Regex)
  68 import qualified Hcompta.Lib.Parsec as R
  69 import qualified Hcompta.Lib.Path as Path
  70 import qualified Hcompta.Tag as Tag
  71 import           Hcompta.Tag (Tag)
  72
  73 data Context f ts t
  74  =   Context
  75  { context_account_prefix :: !(Maybe Account)
  76  , context_aliases_exact :: !(Data.Map.Map Account Account)
  77  , context_aliases_joker :: ![(Account.Joker, Account)]
  78  , context_aliases_regex :: ![(Regex, Account)]
  79  , context_date :: !Date
  80  , context_filter :: !f
  81  , context_journal :: !(Journal (ts t))
  82  , context_unit_and_style :: !(Maybe (Amount.Unit, Amount.Style))
  83  , context_year :: !Date.Year
  84  } deriving (Show)
  85
  86 context
  87  :: (Show f, Consable f ts t)
  88  => f -> Journal (ts t) -> Context f ts t
  89 context flt context_journal =
  90         Context
  91          { context_account_prefix = Nothing
  92          , context_aliases_exact = Data.Map.empty
  93          , context_aliases_joker = []
  94          , context_aliases_regex = []
  95          , context_date = Date.nil
  96          , context_filter = flt
  97          , context_journal
  98          , context_unit_and_style = Nothing
  99          , context_year = Date.year Date.nil
 100          }
 101
 102 data Error
 103  =   Error_date Date.Read.Error
 104  |   Error_transaction_not_equilibrated Transaction [Balance.Unit_Sum (Balance.Posting_Amount Ledger.Posting)]
 105  |   Error_virtual_transaction_not_equilibrated Transaction [Balance.Unit_Sum (Balance.Posting_Amount Ledger.Posting)]
 106  |   Error_reading_file FilePath Exception.IOException
 107  |   Error_including_file FilePath [R.Error Error]
 108  deriving (Show)
 109
 110 -- * Directives
 111
 112 directive_alias
 113  :: (Consable f ts t, Stream s m Char)
 114  => ParsecT s (Context f ts t) m ()
 115 directive_alias = do
 116         _ <- R.string "alias"
 117         R.skipMany1 $ R.space_horizontal
 118         pattern <- Account.Read.pattern
 119         R.skipMany $ R.space_horizontal
 120         _ <- R.char '='
 121         R.skipMany $ R.space_horizontal
 122         repl <- Account.Read.account
 123         R.skipMany $ R.space_horizontal
 124         case pattern of
 125          Account.Pattern_Exact acct -> R.modifyState $ \ctx -> ctx{context_aliases_exact=
 126                 Data.Map.insert acct repl $ context_aliases_exact ctx}
 127          Account.Pattern_Joker jokr -> R.modifyState $ \ctx -> ctx{context_aliases_joker=
 128                 (jokr, repl):context_aliases_joker ctx}
 129          Account.Pattern_Regex regx -> R.modifyState $ \ctx -> ctx{context_aliases_regex=
 130                 (regx, repl):context_aliases_regex ctx}
 131         return ()
 132
 133 -- * Read 'Comment'
 134
 135 comment_begin :: Char
 136 comment_begin = ';'
 137
 138 comment :: Stream s m Char => ParsecT s u m Comment
 139 comment = (do
 140         _ <- R.char comment_begin
 141         fromString <$> do
 142         R.manyTill R.anyChar (R.lookAhead R.new_line <|> R.eof)
 143         ) <?> "comment"
 144
 145 comments :: Stream s m Char => ParsecT s u m [Comment]
 146 comments = (do
 147         R.try $ do
 148                 _ <- R.spaces
 149                 R.many1_separated comment (R.new_line >> R.skipMany R.space_horizontal)
 150         <|> return []
 151         ) <?> "comments"
 152
 153 -- * Read 'Tag'
 154
 155 tag_value_sep :: Char
 156 tag_value_sep = ':'
 157
 158 tag_sep :: Char
 159 tag_sep = ','
 160
 161 tag_path_section_char :: Stream s m Char => ParsecT s u m Char
 162 tag_path_section_char =
 163         R.satisfy (\c -> c /= tag_value_sep && c /= tag_sep && not (Data.Char.isSpace c))
 164
 165 tag :: Stream s m Char => ParsecT s u m Tag
 166 tag = ((,) <$> tag_path <*> tag_value) <?> "tag"
 167
 168 tag_path :: Stream s m Char => ParsecT s u m Tag.Path
 169 tag_path = do
 170         NonEmpty.fromList <$> do
 171         R.many1 $ R.try tag_path_section
 172
 173 tag_path_section :: Stream s m Char => ParsecT s u m Tag.Section
 174 tag_path_section = do
 175         fromString <$> do
 176                 ((R.many1 $ tag_path_section_char) <* R.char tag_value_sep)
 177
 178 tag_value :: Stream s m Char => ParsecT s u m Tag.Value
 179 tag_value = do
 180         fromString <$> do
 181         R.manyTill R.anyChar $ do
 182                 R.lookAhead $ do
 183                         R.try (R.char tag_sep >> R.many R.space_horizontal >> void tag_path_section)
 184                         <|> R.try (void (R.try R.new_line))
 185                         <|> R.eof
 186
 187 tags :: Stream s m Char => ParsecT s u m (Map Tag.Path [Tag.Value])
 188 tags = do
 189         Data.Map.fromListWith (flip (++))
 190         . map (\(p, v) -> (p, [v])) <$> do
 191                 R.many_separated tag $ do
 192                         _ <- R.char tag_sep
 193                         R.skipMany $ R.space_horizontal
 194
 195 not_tag :: Stream s m Char => ParsecT s u m ()
 196 not_tag = do
 197         R.skipMany $ R.try $ do
 198                 R.skipMany $ tag_path_section_char
 199                 R.space_horizontal
 200
 201 -- * Read 'Posting'
 202
 203 posting
 204  :: (Consable f ts t, Stream s (R.Error_State Error m) Char, Monad m)
 205  => ParsecT s (Context f ts t) (R.Error_State Error m) (Posting, Posting.Posting_Type)
 206 posting = (do
 207         ctx <- R.getState
 208         sourcepos <- R.getPosition
 209         R.skipMany1 $ R.space_horizontal
 210         status_ <- status
 211         R.skipMany $ R.space_horizontal
 212         acct <- Account.Read.account
 213         let (type_, account_) = posting_type acct
 214         amounts_ <-
 215                 R.choice_try
 216                  [ do
 217                         (void R.tab <|> void (R.count 2 R.space_horizontal))
 218                         R.skipMany $ R.space_horizontal
 219                         maybe id (\(u, s) ->
 220                                 if u == Unit.nil then id
 221                                 else
 222                                         Data.Map.adjust (\a ->
 223                                                 a{ Amount.style = s{Style.precision = Style.precision $ Amount.style a}
 224                                                  , Amount.unit  = u })
 225                                          Unit.nil)
 226                          (context_unit_and_style ctx) .
 227                          Amount.from_List <$> do
 228                                 R.many_separated Amount.Read.amount $ do
 229                                         R.skipMany $ R.space_horizontal
 230                                         _ <- R.char amount_sep
 231                                         R.skipMany $ R.space_horizontal
 232                                         return ()
 233                  , return Data.Map.empty
 234                  ] <?> "amounts"
 235         R.skipMany $ R.space_horizontal
 236         -- TODO: balance assertion
 237         -- TODO: conversion
 238         comments_ <- comments
 239         let tags_ = tags_of_comments comments_
 240         dates_ <-
 241                 case Data.Map.lookup ("date":|[]) tags_ of
 242                  Nothing -> return []
 243                  Just dates -> do
 244                         let date2s = Data.Map.lookup ("date2":|[]) tags_ -- NOTE: support hledger's date2
 245                         do
 246                         forM (dates ++ fromMaybe [] date2s) $ \s ->
 247                                 R.runParserT_with_Error_fail "tag date" id
 248                                  (Date.Read.date Error_date (Just $ context_year ctx) <* R.eof) ()
 249                                  (Text.unpack s) s
 250                         >>= \dates_ -> case (dates, date2s) of -- NOTE: put hledger's date2 at least in second position
 251                          ([], Just (_:_)) ->
 252                                 return $ context_date ctx:dates_
 253                          _ -> return $ dates_
 254         return (Posting
 255          { posting_account=account_
 256          , posting_amounts=amounts_
 257          , posting_comments=comments_
 258          , posting_dates=dates_
 259          , posting_sourcepos=sourcepos
 260          , posting_status=status_
 261          , posting_tags=tags_
 262          }, type_)
 263         ) <?> "posting"
 264
 265 amount_sep :: Char
 266 amount_sep = '+'
 267
 268 tags_of_comments :: [Comment] -> Map Tag.Path [Tag.Value]
 269 tags_of_comments =
 270         Data.Map.unionsWith (++)
 271         . Data.List.map
 272          ( Data.Either.either (const Data.Map.empty) id
 273          . R.runParser (not_tag >> tags <* R.eof) () "" )
 274
 275 status :: Stream s m Char => ParsecT s u m Ledger.Status
 276 status = (do
 277         ( R.try $ do
 278                 R.skipMany $ R.space_horizontal
 279                 _ <- (R.char '*' <|> R.char '!')
 280                 return True )
 281         <|> return False
 282         ) <?> "status"
 283
 284 -- | Return the 'Posting_Type' and stripped 'Account' of the given 'Account'.
 285 posting_type :: Account -> (Posting_Type, Account)
 286 posting_type acct =
 287         fromMaybe (Posting_Type_Regular, acct) $ do
 288                 case acct of
 289                  name:|[] ->
 290                         case Text.stripPrefix virtual_begin name of
 291                          Just name' -> do
 292                                 name'' <- liftM Text.strip $ Text.stripSuffix virtual_end name'
 293                                 guard $ not $ Text.null name''
 294                                 Just (Posting_Type_Virtual, name'':|[])
 295                          Nothing -> do
 296                                 name' <- liftM Text.strip $
 297                                             Text.stripPrefix virtual_balanced_begin name
 298                                         >>= Text.stripSuffix virtual_balanced_end
 299                                 guard $ not $ Text.null name'
 300                                 Just (Posting_Type_Virtual_Balanced, name':|[])
 301                  first_name:|acct' -> do
 302                         let rev_acct' = Data.List.reverse acct'
 303                         let last_name = Data.List.head rev_acct'
 304                         case liftM Text.stripStart $
 305                                 Text.stripPrefix virtual_begin first_name of
 306                          Just first_name' -> do
 307                                 last_name' <- liftM Text.stripEnd $
 308                                         Text.stripSuffix virtual_end last_name
 309                                 guard $ not $ Text.null first_name'
 310                                 guard $ not $ Text.null last_name'
 311                                 Just $
 312                                         ( Posting_Type_Virtual
 313                                         , first_name':|
 314                                                 Data.List.reverse (last_name':Data.List.tail rev_acct')
 315                                         )
 316                          Nothing -> do
 317                                 first_name' <- liftM Text.stripStart $
 318                                         Text.stripPrefix virtual_balanced_begin first_name
 319                                 last_name'  <- liftM Text.stripEnd $
 320                                         Text.stripSuffix virtual_balanced_end last_name
 321                                 guard $ not $ Text.null first_name'
 322                                 guard $ not $ Text.null last_name'
 323                                 Just $
 324                                         ( Posting_Type_Virtual_Balanced
 325                                         , first_name':|
 326                                                 Data.List.reverse (last_name':Data.List.tail rev_acct')
 327                                         )
 328         where
 329                 virtual_begin          = Text.singleton posting_type_virtual_begin
 330                 virtual_end            = Text.singleton posting_type_virtual_end
 331                 virtual_balanced_begin = Text.singleton posting_type_virtual_balanced_begin
 332                 virtual_balanced_end   = Text.singleton posting_type_virtual_balanced_end
 333
 334 posting_type_virtual_begin :: Char
 335 posting_type_virtual_begin = '('
 336 posting_type_virtual_balanced_begin :: Char
 337 posting_type_virtual_balanced_begin = '['
 338 posting_type_virtual_end :: Char
 339 posting_type_virtual_end = ')'
 340 posting_type_virtual_balanced_end :: Char
 341 posting_type_virtual_balanced_end = ']'
 342
 343 -- * Read 'Transaction'
 344
 345 transaction
 346  :: (Consable f ts t, Stream s (R.Error_State Error m) Char, Monad m)
 347  => ParsecT s (Context f ts t) (R.Error_State Error m) Transaction
 348 transaction = (do
 349         ctx <- R.getState
 350         transaction_sourcepos <- R.getPosition
 351         transaction_comments_before <-
 352                 comments
 353                 >>= \x -> case x of
 354                  [] -> return []
 355                  _  -> return x <* R.new_line
 356         date_ <- Date.Read.date Error_date (Just $ context_year ctx)
 357         dates_ <-
 358                 R.option [] $ R.try $ do
 359                         R.skipMany $ R.space_horizontal
 360                         _ <- R.char date_sep
 361                         R.skipMany $ R.space_horizontal
 362                         R.many_separated
 363                          (Date.Read.date Error_date (Just $ context_year ctx)) $
 364                                 R.try $ do
 365                                         R.many $ R.space_horizontal
 366                                         >> R.char date_sep
 367                                         >> (R.many $ R.space_horizontal)
 368         let transaction_dates = (date_, dates_)
 369         R.skipMany $ R.space_horizontal
 370         transaction_status <- status
 371         transaction_code <- R.option "" $ R.try code
 372         R.skipMany $ R.space_horizontal
 373         transaction_description <- description
 374         R.skipMany $ R.space_horizontal
 375         transaction_comments_after <- comments
 376         let transaction_tags =
 377                 Data.Map.unionWith (++)
 378                  (tags_of_comments transaction_comments_before)
 379                  (tags_of_comments transaction_comments_after)
 380         R.new_line
 381         (postings_unchecked, postings_not_regular) <-
 382                 first (Ledger.posting_by_Account . Data.List.map fst) .
 383                 Data.List.partition ((Posting.Posting_Type_Regular ==) . snd) <$>
 384                 R.many1_separated posting R.new_line
 385         let (transaction_virtual_postings, balanced_virtual_postings_unchecked) =
 386                 join (***) (Ledger.posting_by_Account . Data.List.map fst) $
 387                 Data.List.partition ((Posting.Posting_Type_Virtual ==) . snd)
 388                  postings_not_regular
 389         let tr_unchecked =
 390                 Transaction
 391                  { transaction_code
 392                  , transaction_comments_before
 393                  , transaction_comments_after
 394                  , transaction_dates
 395                  , transaction_description
 396                  , transaction_postings=postings_unchecked
 397                  , transaction_virtual_postings
 398                  , transaction_balanced_virtual_postings=balanced_virtual_postings_unchecked
 399                  , transaction_sourcepos
 400                  , transaction_status
 401                  , transaction_tags
 402                  }
 403         transaction_postings <-
 404                 case Balance.infer_equilibrium postings_unchecked of
 405                  (_, Left ko) -> R.fail_with "transaction infer_equilibrium"
 406                                              (Error_transaction_not_equilibrated tr_unchecked ko)
 407                  (_bal, Right ok) -> return ok
 408         transaction_balanced_virtual_postings <-
 409                 case Balance.infer_equilibrium balanced_virtual_postings_unchecked of
 410                  (_, Left ko) -> R.fail_with "transaction infer_equilibrium"
 411                                              (Error_virtual_transaction_not_equilibrated tr_unchecked ko)
 412                  (_bal, Right ok) -> return ok
 413         return $
 414                 tr_unchecked
 415                  { transaction_postings
 416                  , transaction_balanced_virtual_postings
 417                  }
 418         ) <?> "transaction"
 419
 420 date_sep :: Char
 421 date_sep = '='
 422
 423 code :: (Consable f ts t, Stream s m Char)
 424  => ParsecT s (Context f ts t) m Ledger.Code
 425 code = (do
 426         fromString <$> do
 427         R.skipMany $ R.space_horizontal
 428         R.between (R.char '(') (R.char ')') $
 429                 R.many $ R.satisfy (\c -> c /= ')' && not (R.is_space_horizontal c))
 430         ) <?> "code"
 431
 432 description :: Stream s m Char => ParsecT s u m Ledger.Description
 433 description = (do
 434         fromString <$> do
 435         R.many $ R.try description_char
 436         ) <?> "description"
 437         where
 438                 description_char :: Stream s m Char => ParsecT s u m Char
 439                 description_char = do
 440                         c <- R.anyChar
 441                         case c of
 442                          _ | c == comment_begin -> R.parserZero
 443                          _ | R.is_space_horizontal c -> return c <* (R.lookAhead $ R.try $ description_char)
 444                          _ | not (Data.Char.isSpace c) -> return c
 445                          _ -> R.parserZero
 446
 447 -- * Read directives
 448
 449 default_year
 450  :: (Consable f ts t, Stream s m Char)
 451  => ParsecT s (Context f ts t) m ()
 452 default_year = (do
 453         year <- R.integer_of_digits 10 <$> R.many1 R.digit
 454         R.skipMany R.space_horizontal >> R.new_line
 455         context_ <- R.getState
 456         R.setState context_{context_year=year}
 457         ) <?> "default year"
 458
 459 default_unit_and_style
 460  :: (Consable f ts t, Stream s m Char)
 461  => ParsecT s (Context f ts t) m ()
 462 default_unit_and_style = (do
 463         amount_ <- Amount.Read.amount
 464         R.skipMany R.space_horizontal >> R.new_line
 465         context_ <- R.getState
 466         R.setState context_{context_unit_and_style =
 467                 Just $
 468                  ( Amount.unit  amount_
 469                  , Amount.style amount_ )}
 470         ) <?> "default unit and style"
 471
 472 include ::
 473  ( Consable f ts Transaction
 474  , Show f
 475  , Show (ts Transaction)
 476  , Stream s (R.Error_State Error IO) Char
 477  )
 478  => ParsecT s (Context f ts Transaction) (R.Error_State Error IO) ()
 479 include = (do
 480         sourcepos <- R.getPosition
 481         filename <- R.manyTill R.anyChar (R.lookAhead R.new_line <|> R.eof)
 482         context_ <- R.getState
 483         let journal_ = context_journal context_
 484         let cwd = Path.takeDirectory (R.sourceName sourcepos)
 485         file_path <- liftIO $ Path.abs cwd filename
 486         content <- do
 487                 join $ liftIO $ Exception.catch
 488                  (liftM return $ readFile file_path)
 489                  (return . R.fail_with "include reading" . Error_reading_file file_path)
 490         (journal_included, context_included) <- do
 491                 liftIO $
 492                         R.runParserT_with_Error (R.and_state $ journal_rec file_path)
 493                          context_{context_journal = Ledger.journal}
 494                          file_path content
 495                 >>= \x -> case x of
 496                  Right ok -> return ok
 497                  Left  ko -> R.fail_with "include parsing" (Error_including_file file_path ko)
 498         R.setState $
 499                 context_included{context_journal=
 500                         journal_{journal_includes=
 501                                 journal_included{journal_file=file_path}
 502                                 : journal_includes journal_}}
 503         ) <?> "include"
 504
 505 -- * Read 'Journal'
 506
 507 journal ::
 508  ( Consable f ts Transaction
 509  , Show f
 510  , Show (ts Transaction)
 511  , Stream s (R.Error_State Error IO) Char
 512  )
 513  => FilePath
 514  -> ParsecT s (Context f ts Transaction) (R.Error_State Error IO) (Journal (ts Transaction))
 515 journal file_ = (do
 516         currentLocalTime <- liftIO $
 517                 Time.utcToLocalTime
 518                 <$> Time.getCurrentTimeZone
 519                 <*> Time.getCurrentTime
 520         let (currentLocalYear, _, _) = Time.toGregorian $ Time.localDay currentLocalTime
 521         ctx <- R.getState
 522         R.setState $ ctx{context_year=currentLocalYear}
 523         journal_rec file_
 524         ) <?> "journal"
 525
 526 journal_rec ::
 527  ( Consable f ts Transaction
 528  , Show f
 529  , Show (ts Transaction)
 530  , Stream s (R.Error_State Error IO) Char
 531  )
 532  => FilePath
 533  -> ParsecT s (Context f ts Transaction) (R.Error_State Error IO) (Journal (ts Transaction))
 534 journal_rec file_ = do
 535         last_read_time <- liftIO Date.now
 536         R.skipMany $ do
 537                 R.choice_try
 538                  [ R.skipMany1 R.space
 539                  , (do (R.choice_try
 540                          [ R.string "Y"        >> return default_year
 541                          , R.string "D"        >> return default_unit_and_style
 542                          , R.string "!include" >> return include
 543                          ] <?> "directive")
 544                                 >>= \r -> R.skipMany1 R.space_horizontal >> r)
 545                  , ((do
 546                                 t <- transaction
 547                                 ctx <- R.getState
 548                                 let j = context_journal ctx
 549                                 R.setState $
 550                                         ctx{context_journal=
 551                                                 j{journal_transactions=
 552                                                         mcons (context_filter ctx) t $
 553                                                                 journal_transactions j}}
 554                                 R.new_line <|> R.eof))
 555                  , R.try (void $ comment)
 556                  ]
 557         R.eof
 558         journal_ <- context_journal <$> R.getState
 559         return $
 560                 journal_
 561                  { journal_file = file_
 562                  , journal_last_read_time = last_read_time
 563                  , journal_includes = reverse $ journal_includes journal_
 564                  }
 565
 566 -- ** Read 'Journal' from a file
 567
 568 file
 569  ::
 570  ( Consable f ts Transaction
 571  , Show f
 572  , Show (ts Transaction)
 573  )
 574  => Context f ts Transaction
 575  -> FilePath
 576  -> ExceptT [R.Error Error] IO (Journal (ts Transaction))
 577 file ctx path = do
 578         ExceptT $
 579                 Exception.catch
 580                  (liftM Right $ Text.IO.readFile path) $
 581                  \ko -> return $ Left $
 582                          [ R.Error_Custom (R.initialPos path) $ Error_reading_file path ko ]
 583         >>= liftIO . R.runParserT_with_Error (journal path) ctx path
 584         >>= \x -> case x of
 585          Left  ko -> throwE $ ko
 586          Right ok -> ExceptT $ return $ Right ok