{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TupleSections #-} {-# LANGUAGE TypeFamilies #-} module Hcompta.Account.Read where import Control.Applicative ((<$>), (<*)) import Control.Monad (Monad(..)) import Data.Bool import Data.Char import Data.Eq (Eq(..)) import Data.Maybe (Maybe(..)) import Data.String (fromString) import Data.Typeable () import Prelude (($), (.)) import qualified Text.Parsec as R hiding ( char , anyChar , crlf , newline , noneOf , oneOf , satisfy , space , spaces , string , tab ) import Text.Parsec (Stream, ParsecT, (<|>)) import qualified Hcompta.Account as Account import Hcompta.Account (Account) import qualified Hcompta.Lib.Regex as Regex import Hcompta.Lib.Regex (Regex) import qualified Hcompta.Lib.Parsec as R -- * Read 'Account' section_sep :: Char section_sep = ':' -- | Read an 'Account'. account :: Stream s m Char => ParsecT s u m Account account = do R.notFollowedBy $ R.space_horizontal Account.from_List <$> do R.many1_separated section $ R.char section_sep -- | Read an Account.'Account.Name'. comment_begin :: Char comment_begin = ';' section :: Stream s m Char => ParsecT s u m Account.Name section = do fromString <$> do R.many1 $ R.try account_name_char where account_name_char :: Stream s m Char => ParsecT s u m Char account_name_char = do c <- R.anyChar case c of _ | c == comment_begin -> R.parserZero _ | c == section_sep -> R.parserZero _ | c /= '\t' && R.is_space_horizontal c -> do _ <- R.notFollowedBy $ R.space_horizontal return c <* (R.lookAhead $ R.try $ ( R.try (R.char section_sep) <|> account_name_char )) _ | not (Data.Char.isSpace c) -> return c _ -> R.parserZero -- | Read an Account.'Account.Joker_Name'. joker_section :: Stream s m Char => ParsecT s u m Account.Joker_Name joker_section = do n <- R.option Nothing $ (Just <$> section) case n of Nothing -> R.char section_sep >> (return $ Account.Joker_Any) Just n' -> return $ Account.Joker_Name n' -- | Read an Account.'Account.Joker'. joker :: Stream s m Char => ParsecT s u m Account.Joker joker = do R.notFollowedBy $ R.space_horizontal R.many1_separated joker_section $ R.char section_sep -- | Read a 'Regex'. regex :: Stream s m Char => ParsecT s u m Regex regex = do re <- R.many1 $ R.satisfy (not . R.is_space_horizontal) Regex.of_StringM re -- | Read an Account.'Account.Filter'. pattern :: Stream s m Char => ParsecT s u m Account.Pattern pattern = do R.choice_try [ Account.Pattern_Exact <$> (R.char '=' >> account) , Account.Pattern_Joker <$> (R.char '*' >> joker) , Account.Pattern_Regex <$> (R.option '~' (R.char '~') >> regex) ]