lcc/Hcompta/LCC/Lib/Parsec.hs

   1 {-# LANGUAGE FlexibleContexts #-}
   2 {-# LANGUAGE Rank2Types #-}
   3 {-# LANGUAGE ScopedTypeVariables #-}
   4 {-# OPTIONS_GHC -fno-warn-orphans #-}
   5 module Hcompta.LCC.Lib.Parsec where
   6
   7 import Control.Monad (Monad(..))
   8 import Data.Char (Char)
   9 import Data.Function (($), (.))
  10 import Data.String (String)
  11 import Prelude (Integer, Integral(..), Num(..), seq)
  12 import Text.Parsec (Stream, ParsecT, (<|>))
  13 import qualified Data.Char as Char
  14 import qualified Data.Foldable as Foldable
  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 :: [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  :: ParsecT s u m a
  39  -> ParsecT s u m b
  40  -> ParsecT s u m [a]
  41 many1_separated p sep = do
  42         x <- p
  43         xs <- R.many (R.try (sep >> p))
  44         return $ x:xs
  45 -- (:) <$> p <*> R.many (R.try (sep >> p))
  46
  47 -- | Make a 'R.ParsecT' also return its user state.
  48 and_state
  49  :: Stream s m t
  50  => ParsecT s u m a
  51  -> ParsecT s u m (a, u)
  52 and_state p = do
  53         a <- p
  54         s <- R.getState
  55         return (a, s)
  56
  57 -- * Numbers
  58
  59 -- | Return the 'Integer' obtained by multiplying the given digits
  60 --   with the power of the given base respective to their rank.
  61 integer_of_digits
  62  :: Integer -- ^ Base.
  63  -> String  -- ^ Digits (MUST be recognised by 'Char.digitToInt').
  64  -> Integer
  65 integer_of_digits base =
  66         Foldable.foldl' (\x d ->
  67                 base*x + toInteger (Char.digitToInt d)) 0
  68
  69 decimal :: Stream s m Char => ParsecT s u m Integer
  70 decimal = integer 10 R.digit
  71 hexadecimal :: Stream s m Char => ParsecT s u m Integer
  72 hexadecimal = R.oneOf "xX" >> integer 16 R.hexDigit
  73 octal :: Stream s m Char => ParsecT s u m Integer
  74 octal = R.oneOf "oO" >> integer 8 R.octDigit
  75
  76 -- | Parse an 'Integer'.
  77 integer :: Stream s m t
  78         => Integer
  79         -> ParsecT s u m Char
  80         -> ParsecT s u m Integer
  81 integer base digit = do
  82         digits <- R.many1 digit
  83         let n = integer_of_digits base digits
  84         seq n (return n)