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