lib/Hcompta/Account/Read.hs

   1 {-# LANGUAGE FlexibleContexts #-}
   2 {-# LANGUAGE NamedFieldPuns #-}
   3 {-# LANGUAGE OverloadedStrings #-}
   4 {-# LANGUAGE ScopedTypeVariables #-}
   5 {-# LANGUAGE TupleSections #-}
   6 {-# LANGUAGE TypeFamilies #-}
   7 module Hcompta.Account.Read where
   8
   9 import qualified Data.Char
  10 import           Data.String (fromString)
  11 import           Data.Typeable ()
  12 import qualified Text.Parsec as R hiding
  13                   ( char
  14                   , anyChar
  15                   , crlf
  16                   , newline
  17                   , noneOf
  18                   , oneOf
  19                   , satisfy
  20                   , space
  21                   , spaces
  22                   , string
  23                   , tab
  24                   )
  25 import           Text.Parsec (Stream, ParsecT, (<|>))
  26
  27 import qualified Hcompta.Account as Account
  28 import           Hcompta.Account (Account)
  29 import qualified Hcompta.Lib.Regex as Regex
  30 import           Hcompta.Lib.Regex (Regex)
  31 import qualified Hcompta.Lib.Parsec as R
  32
  33 -- * Read 'Account'
  34
  35 section_sep :: Char
  36 section_sep = ':'
  37
  38 -- | Read an 'Account'.
  39 account :: Stream s m Char => ParsecT s u m Account
  40 account = do
  41         R.notFollowedBy $ R.space_horizontal
  42         Account.from_List <$> do
  43         R.many1_separated section $ R.char section_sep
  44
  45 -- | Read an Account.'Account.Name'.
  46 comment_begin :: Char
  47 comment_begin = ';'
  48
  49 section :: Stream s m Char => ParsecT s u m Account.Name
  50 section = do
  51         fromString <$> do
  52         R.many1 $ R.try account_name_char
  53         where
  54                 account_name_char :: Stream s m Char => ParsecT s u m Char
  55                 account_name_char = do
  56                         c <- R.anyChar
  57                         case c of
  58                          _ | c == comment_begin -> R.parserZero
  59                          _ | c == section_sep -> R.parserZero
  60                          _ | c /= '\t' && R.is_space_horizontal c -> do
  61                                 _ <- R.notFollowedBy $ R.space_horizontal
  62                                 return c <* (R.lookAhead $ R.try $
  63                                  ( R.try (R.char section_sep)
  64                                  <|> account_name_char
  65                                  ))
  66                          _ | not (Data.Char.isSpace c) -> return c
  67                          _ -> R.parserZero
  68
  69 -- | Read an Account.'Account.Joker_Name'.
  70 joker_section :: Stream s m Char => ParsecT s u m Account.Joker_Name
  71 joker_section = do
  72         n <- R.option Nothing $ (Just <$> section)
  73         case n of
  74          Nothing -> R.char section_sep >> (return $ Account.Joker_Any)
  75          Just n' -> return $ Account.Joker_Name n'
  76
  77 -- | Read an Account.'Account.Joker'.
  78 joker :: Stream s m Char => ParsecT s u m Account.Joker
  79 joker = do
  80         R.notFollowedBy $ R.space_horizontal
  81         R.many1_separated joker_section $ R.char section_sep
  82
  83 -- | Read a 'Regex'.
  84 regex :: Stream s m Char => ParsecT s u m Regex
  85 regex = do
  86         re <- R.many1 $ R.satisfy (not . R.is_space_horizontal)
  87         Regex.of_StringM re
  88
  89 -- | Read an Account.'Account.Filter'.
  90 pattern :: Stream s m Char => ParsecT s u m Account.Pattern
  91 pattern = do
  92         R.choice_try
  93          [ Account.Pattern_Exact <$> (R.char '=' >> account)
  94          , Account.Pattern_Joker <$> (R.char '*' >> joker)
  95          , Account.Pattern_Regex <$> (R.option '~' (R.char '~') >> regex)
  96          ]