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