ledger/Hcompta/Ledger/Lib/Parsec.hs

   1 {-# LANGUAGE FlexibleContexts #-}
   2 {-# LANGUAGE Rank2Types #-}
   3 {-# LANGUAGE ScopedTypeVariables #-}
   4 {-# OPTIONS_GHC -fno-warn-orphans #-}
   5 module Hcompta.Ledger.Lib.Parsec where
   6
   7 import           Control.Monad (Monad(..))
   8 import           Data.Char (Char)
   9 import qualified Data.Char as Char
  10 import qualified Data.Foldable as Foldable
  11 import           Data.Function (($), (.))
  12 import           Data.String (String)
  13 import           Prelude (Integer, Integral(..), Num(..), seq)
  14 import           Text.Parsec (Stream, ParsecT, (<|>))
  15 import qualified Text.Parsec as R
  16
  17 -- * Useful combinators
  18
  19 -- | Like 'R.choice' but with 'R.try' on each case.
  20 choice_try :: Stream s m t => [ParsecT s u m a] -> ParsecT s u m a
  21 choice_try = Foldable.foldr ((<|>) . R.try) R.parserZero
  22 -- choice_try = R.choice . fmap R.try
  23
  24 -- | Like 'R.sepBy' but without parsing an ending separator.
  25 many_separated
  26  :: Stream s m t
  27  => ParsecT s u m a
  28  -> ParsecT s u m b
  29  -> ParsecT s u m [a]
  30 many_separated p sep =
  31         R.option [] $ do
  32                 x <- R.try p
  33                 xs <- R.many (R.try (sep >> p))
  34                 return $ x:xs
  35
  36 -- | Like 'R.sepBy1' but without parsing an ending separator.
  37 many1_separated
  38  :: Stream s m t
  39  => ParsecT s u m a
  40  -> ParsecT s u m b
  41  -> ParsecT s u m [a]
  42 many1_separated p sep = do
  43         x <- p
  44         xs <- R.many (R.try (sep >> p))
  45         return $ x:xs
  46 -- (:) <$> p <*> R.many (R.try (sep >> p))
  47
  48 -- | Make a 'R.ParsecT' also return its user state.
  49 and_state
  50  :: Stream s m t
  51  => ParsecT s u m a
  52  -> ParsecT s u m (a, u)
  53 and_state p = do
  54         a <- p
  55         s <- R.getState
  56         return (a, s)
  57
  58 -- * Numbers
  59
  60 -- | Return the 'Integer' obtained by multiplying the given digits
  61 --   with the power of the given base respective to their rank.
  62 integer_of_digits
  63  :: Integer -- ^ Base.
  64  -> String  -- ^ Digits (MUST be recognised by 'Char.digitToInt').
  65  -> Integer
  66 integer_of_digits base =
  67         Foldable.foldl' (\x d ->
  68                 base*x + toInteger (Char.digitToInt d)) 0
  69
  70 decimal :: Stream s m Char => ParsecT s u m Integer
  71 decimal = integer 10 R.digit
  72 hexadecimal :: Stream s m Char => ParsecT s u m Integer
  73 hexadecimal = R.oneOf "xX" >> integer 16 R.hexDigit
  74 octal :: Stream s m Char => ParsecT s u m Integer
  75 octal = R.oneOf "oO" >> integer 8 R.octDigit
  76
  77 -- | Parse an 'Integer'.
  78 integer :: Stream s m t
  79         => Integer
  80         -> ParsecT s u m Char
  81         -> ParsecT s u m Integer
  82 integer base digit = do
  83         digits <- R.many1 digit
  84         let n = integer_of_digits base digits
  85         seq n (return n)