lib/Hcompta/Lib/Parsec.hs

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