]> Git — Sourcephile - comptalang.git/blob - lcc/Hcompta/LCC/Lib/Parsec.hs
Remove ledger/
[comptalang.git] / 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)