]> Git — Sourcephile - comptalang.git/blob - lib/Hcompta/Account/Read.hs
Correction : compatiblité avec GHC-7.6 en limitant l’usage de Prelude.
[comptalang.git] / 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 Control.Applicative ((<$>), (<*))
10 import Control.Monad (Monad(..))
11 import Data.Bool
12 import Data.Char
13 import Data.Eq (Eq(..))
14 import Data.Maybe (Maybe(..))
15 import Data.String (fromString)
16 import Data.Typeable ()
17 import Prelude (($), (.))
18 import qualified Text.Parsec as R hiding
19 ( char
20 , anyChar
21 , crlf
22 , newline
23 , noneOf
24 , oneOf
25 , satisfy
26 , space
27 , spaces
28 , string
29 , tab
30 )
31 import Text.Parsec (Stream, ParsecT, (<|>))
32
33 import qualified Hcompta.Account as Account
34 import Hcompta.Account (Account)
35 import qualified Hcompta.Lib.Regex as Regex
36 import Hcompta.Lib.Regex (Regex)
37 import qualified Hcompta.Lib.Parsec as R
38
39 -- * Read 'Account'
40
41 section_sep :: Char
42 section_sep = ':'
43
44 -- | Read an 'Account'.
45 account :: Stream s m Char => ParsecT s u m Account
46 account = do
47 R.notFollowedBy $ R.space_horizontal
48 Account.from_List <$> do
49 R.many1_separated section $ R.char section_sep
50
51 -- | Read an Account.'Account.Name'.
52 comment_begin :: Char
53 comment_begin = ';'
54
55 section :: Stream s m Char => ParsecT s u m Account.Name
56 section = do
57 fromString <$> do
58 R.many1 $ R.try account_name_char
59 where
60 account_name_char :: Stream s m Char => ParsecT s u m Char
61 account_name_char = do
62 c <- R.anyChar
63 case c of
64 _ | c == comment_begin -> R.parserZero
65 _ | c == section_sep -> R.parserZero
66 _ | c /= '\t' && R.is_space_horizontal c -> do
67 _ <- R.notFollowedBy $ R.space_horizontal
68 return c <* (R.lookAhead $ R.try $
69 ( R.try (R.char section_sep)
70 <|> account_name_char
71 ))
72 _ | not (Data.Char.isSpace c) -> return c
73 _ -> R.parserZero
74
75 -- | Read an Account.'Account.Joker_Name'.
76 joker_section :: Stream s m Char => ParsecT s u m Account.Joker_Name
77 joker_section = do
78 n <- R.option Nothing $ (Just <$> section)
79 case n of
80 Nothing -> R.char section_sep >> (return $ Account.Joker_Any)
81 Just n' -> return $ Account.Joker_Name n'
82
83 -- | Read an Account.'Account.Joker'.
84 joker :: Stream s m Char => ParsecT s u m Account.Joker
85 joker = do
86 R.notFollowedBy $ R.space_horizontal
87 R.many1_separated joker_section $ R.char section_sep
88
89 -- | Read a 'Regex'.
90 regex :: Stream s m Char => ParsecT s u m Regex
91 regex = do
92 re <- R.many1 $ R.satisfy (not . R.is_space_horizontal)
93 Regex.of_StringM re
94
95 -- | Read an Account.'Account.Filter'.
96 pattern :: Stream s m Char => ParsecT s u m Account.Pattern
97 pattern = do
98 R.choice_try
99 [ Account.Pattern_Exact <$> (R.char '=' >> account)
100 , Account.Pattern_Joker <$> (R.char '*' >> joker)
101 , Account.Pattern_Regex <$> (R.option '~' (R.char '~') >> regex)
102 ]