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                  }