]> Git — Sourcephile - comptalang.git/blob - lib/Hcompta/Filter/Amount/Read.hs
Déplace hcompta-calculus vers lol-calculus et lol-typing
[comptalang.git] / lib / Hcompta / Filter / Amount / Read.hs
1 {-# LANGUAGE DeriveDataTypeable #-}
2 {-# LANGUAGE FlexibleContexts #-}
3 {-# LANGUAGE FlexibleInstances #-}
4 {-# LANGUAGE StandaloneDeriving #-}
5 {-# LANGUAGE TypeFamilies #-}
6 {-# OPTIONS_GHC -fno-warn-orphans #-}
7 module Hcompta.Filter.Amount.Read where
8
9 import Control.Applicative ((<$>), (<*))
10 import Control.Monad (Monad(..), guard, void)
11 import Data.Bool
12 import Data.Char
13 import Data.Decimal (DecimalRaw(..))
14 import qualified Data.List as List
15 import Data.Maybe (Maybe(..))
16 import Data.Monoid (Monoid(..))
17 import Data.Ord (Ord(..))
18 import Data.String (String)
19 import qualified Data.Text as Text
20 import Data.Typeable ()
21 import Prelude (($), (.), fromIntegral, Num(..), id)
22 import qualified Text.Parsec as R hiding
23 ( char
24 , anyChar
25 , crlf
26 , newline
27 , noneOf
28 , oneOf
29 , satisfy
30 , space
31 , spaces
32 , string
33 )
34 import Text.Parsec (Stream, ParsecT, (<|>), (<?>))
35
36 import Hcompta.Filter.Amount
37 import qualified Hcompta.Lib.Parsec as R
38 import qualified Hcompta.Unit as Unit
39
40 -- * Read 'Amount'
41
42 quantity :: Stream s m Char => ParsecT s u m Quantity
43 quantity = do
44 signing <- sign
45 (integral, fractional) <-
46 R.choice_try
47 [ try_quantity '_' ',' '_' <* (R.notFollowedBy $ R.oneOf ",._")
48 , try_quantity '_' '.' '_' <* (R.notFollowedBy $ R.oneOf ",._")
49 , try_quantity ',' '.' '_' <* (R.notFollowedBy $ R.oneOf ",._")
50 , try_quantity '.' ',' '_' <* (R.notFollowedBy $ R.oneOf ",._")
51 ] <?> "quantity"
52 let int = List.concat integral
53 let frac = List.concat fractional
54 let precision = List.length frac
55 guard (precision <= 255)
56 let mantissa = R.integer_of_digits 10 $ int `mappend` frac
57 return $
58 Decimal
59 (fromIntegral precision)
60 (signing mantissa)
61 where
62 try_quantity int_group_sep frac_sep frac_group_sep = do
63 integral <- do
64 h <- R.many R.digit
65 case h of
66 [] -> return []
67 _ -> do
68 t <- R.many $ R.char int_group_sep >> R.many1 R.digit
69 return (h:t)
70 fractional <-
71 (case integral of
72 [] -> id
73 _ -> R.option []) $ do
74 void $ R.char frac_sep
75 h <- R.many R.digit
76 t <- R.many $ R.char frac_group_sep >> R.many1 R.digit
77 return (h:t)
78 return ((integral::[String]), (fractional::[String]))
79
80 unit :: Stream s m Char => ParsecT s u m Unit
81 unit =
82 (quoted <|> unquoted) <?> "unit"
83 where
84 unquoted :: Stream s m Char => ParsecT s u m Unit
85 unquoted =
86 Unit . Text.pack <$> do
87 R.many1 $
88 R.satisfy $ \c ->
89 case Data.Char.generalCategory c of
90 Data.Char.CurrencySymbol -> True
91 Data.Char.LowercaseLetter -> True
92 Data.Char.ModifierLetter -> True
93 Data.Char.OtherLetter -> True
94 Data.Char.TitlecaseLetter -> True
95 Data.Char.UppercaseLetter -> True
96 _ -> False
97 quoted :: Stream s m Char => ParsecT s u m Unit
98 quoted =
99 Unit . Text.pack <$> do
100 R.between (R.char '"') (R.char '"') $
101 R.many1 $
102 R.noneOf ";\n\""
103
104 -- | Parse either '-' into 'negate', or '+' or '' into 'id'.
105 sign :: (Stream s m Char, Num i) => ParsecT s u m (i -> i)
106 sign =
107 (R.char '-' >> return negate)
108 <|> (R.char '+' >> return id)
109 <|> return id
110
111 amount :: Stream s m Char => ParsecT s u m Amount
112 amount = do
113 left_signing <- sign
114 left_unit <-
115 R.option Nothing $ do
116 u <- unit
117 R.skipMany R.space_horizontal
118 return $ Just u
119 quantity_ <- quantity
120 unit_ <-
121 case left_unit of
122 Just u -> return u
123 Nothing ->
124 R.option (Unit.unit_empty) $ R.try $ do
125 R.skipMany R.space_horizontal
126 unit
127 return $
128 Amount
129 { amount_quantity = left_signing quantity_
130 , amount_unit = unit_
131 }