on master help sign in
Implemented optional, opt, opt_.
6a334b9Paweł Nowak
Data/Syntax/Char.hs+14−17
@@ -18,18 +18,16 @@ module Data.Syntax.Char (
18 spaces,
18 spaces,
19 spaces_,
19 spaces_,
20 spaces1,
20 spaces1,
21− spaces1_,
22 endOfLine
21 endOfLine
23 ) where
22 ) where
24
23
25−import Control.Lens.SemiIso
24+import Control.Lens.SemiIso
26−import Data.Char
25+import Data.Char
27−import Data.MonoTraversable
26+import Data.MonoTraversable
28−import Data.Monoid
29−import Data.Scientific (Scientific)
27+import Data.Scientific (Scientific)
30−import Data.SemiIsoFunctor
28+import Data.SemiIsoFunctor
31−import Data.Syntax (Syntax)
29+import Data.Syntax
32−import qualified Data.Syntax as S
30+import Data.Syntax.Combinator
33
31
34-- | Syntax constrainted to sequences of chars.
32-- | Syntax constrainted to sequences of chars.
35--
33--
@@ -45,23 +43,22 @@ class (Syntax syn seq, Element seq ~ Char) => SyntaxChar syn seq where
45 {-# MINIMAL decimal, scientific #-}
43 {-# MINIMAL decimal, scientific #-}
46
44
47-- | A number with an optional leading '+' or '-' sign character.
45-- | A number with an optional leading '+' or '-' sign character.
48−signed :: (Num a, SyntaxChar syn seq) => syn a -> syn a
46+signed :: (Real a, SyntaxChar syn seq) => syn a -> syn a
49−signed n = _Negative /$/ S.char '-' */ n
47+signed n = _Negative /$/ char '-' */ n
50− /|/ S.char '+' */ n
48+ /|/ opt_ (char '+') */ n
51− /|/ n
52
49
53-- | Accepts zero or more spaces. Generates a single space.
50-- | Accepts zero or more spaces. Generates a single space.
54spaces :: SyntaxChar syn seq => syn ()
51spaces :: SyntaxChar syn seq => syn ()
55−spaces = constant (opoint ' ') /$/ S.takeWhile isSpace
52+spaces = opt spaces1
56
53
57-- | Accepts zero or more spaces. Generates no output.
54-- | Accepts zero or more spaces. Generates no output.
58spaces_ :: SyntaxChar syn seq => syn ()
55spaces_ :: SyntaxChar syn seq => syn ()
59−spaces_ = constant mempty /$/ S.takeWhile isSpace
56+spaces_ = opt_ spaces1
60
57
61-- | Accepts one or more spaces. Generates a single space.
58-- | Accepts one or more spaces. Generates a single space.
62spaces1 :: SyntaxChar syn seq => syn ()
59spaces1 :: SyntaxChar syn seq => syn ()
63−spaces1 = constant (opoint ' ') /$/ S.takeWhile1 isSpace
60+spaces1 = constant (opoint ' ') /$/ takeWhile1 isSpace
64
61
65-- | Accepts a single newline. Generates a newline.
62-- | Accepts a single newline. Generates a newline.
66endOfLine :: SyntaxChar syn seq => syn ()
63endOfLine :: SyntaxChar syn seq => syn ()
67−endOfLine = S.char '\n'
64+endOfLine = char '\n'
Data/Syntax/Combinator.hs+15−10
@@ -11,23 +11,28 @@ Combinators that work with any sequence type.
11-}
11-}
12module Data.Syntax.Combinator where
12module Data.Syntax.Combinator where
13
13
14−import Control.Lens.Cons
14+import Control.Lens
15−import Control.Lens.Empty
15+import Control.Lens.SemiIso
16import Data.SemiIsoFunctor
16import Data.SemiIsoFunctor
17
17
18−-- | Zero or more occurences of v separated by s.
18+-- | Zero or more occurences of @v@ separated by @s@.
19sepBy :: SemiIsoAlternative f => f a -> f () -> f [a]
19sepBy :: SemiIsoAlternative f => f a -> f () -> f [a]
20sepBy v s = sepBy1 v s
20sepBy v s = sepBy1 v s
21 /|/ sipure _Empty
21 /|/ sipure _Empty
22
22
23−-- | One or more occurences of v separated by s.
23+-- | One or more occurences of @v@ separated by @s@.
24sepBy1 :: SemiIsoAlternative f => f a -> f () -> f [a]
24sepBy1 :: SemiIsoAlternative f => f a -> f () -> f [a]
25sepBy1 v s = _Cons /$/ v /*/ (s */ sepBy1 v s /|/ sipure _Empty)
25sepBy1 v s = _Cons /$/ v /*/ (s */ sepBy1 v s /|/ sipure _Empty)
26
26
27−-- |
27+-- | One or none occurences of @f@.
28−couldBe :: SemiIsoFunctor f => f () -> f ()
28+optional :: SemiIsoAlternative f => f a -> f (Maybe a)
29−couldBe f = undefined
29+optional f = _Just /$/ f /|/ sipure _Nothing
30
30
31−-- | Something that should be, but doesn't have to be.
31+-- | Like 'optional', but specialized for @()@.
32+opt :: SemiIsoAlternative f => f () -> f ()
33+opt f = f /|/ sipure id
34+
35+-- | Parser one or more occurences of @f@, but prints nothing.
32−shouldBe :: SemiIsoAlternative f => f () -> f ()
36+opt_ :: SemiIsoAlternative f => f () -> f ()
33−shouldBe f = constant () /$/ f
37+opt_ f = semiIso (const (Left "opt_")) Right /$/ f
38+ /|/ sipure id