@@ -0,0 +1,124 @@
1+{-# LANGUAGE FlexibleContexts #-}
2+{-# LANGUAGE DefaultSignatures #-}
3+{-# LANGUAGE MultiParamTypeClasses #-}
4+{-# LANGUAGE FunctionalDependencies #-}
7+Description : Abstract syntax description.
8+Copyright : (c) Paweł Nowak
11+Maintainer : Paweł Nowak <pawel834@gmail.com>
12+Stability : experimental
14+Abstract syntax descriptions based on semi-isomorphisms.
19+ -- * Common isomorphisms.
23+import Prelude hiding (take, takeWhile)
26+import Control.Lens.SemiIso
27+import Data.MonoTraversable
28+import Data.SemiIsoFunctor
29+import Data.Sequences hiding (take, takeWhile)
31+-- | An isomorphism between a sequence and a list of its elements.
32+packed :: IsSequence seq => Iso' seq [Element seq]
33+packed = iso otoList fromList
35+-- | An abstract syntax description based on semi-isomorphisms.
37+-- This class can be implemented by both parsers and printers (and maybe more?).
39+-- The usual use is to write a polymorphic syntax description and instantiate it
40+-- both as a parser and a printer. An example syntax description:
42+-- > | A simple untyped lambda calculus.
43+-- > data AST = Var Text
48+-- > $(makePrisms ''AST)
50+-- > -- | A variable name.
51+-- > name :: Syntax syn Text => syn Text
52+-- > name = S.takeWhile1 isAlphaNum
54+-- > -- | Encloses a symbol in parentheses.
55+-- > parens :: Syntax syn Text => syn a -> syn a
56+-- > parens m = S.char '(' */ S.spaces_ */ m /* S.spaces_ /* S.char ')'
58+-- > -- | An atom is a variable or an expression in parentheses.
59+-- > atom :: Syntax syn Text => syn AST
60+-- > atom = _Var /$/ name
63+-- > -- | An expression of our lambda calculus.
64+-- > expr :: Syntax syn Text => syn AST
65+-- > expr = _App /$/ atom /* S.spaces1 /*/ atom
66+-- > /|/ _Abs /$/ S.char '\\' /* S.spaces_
67+-- > */ name /* S.spaces
68+-- > /* S.string "->" /* S.spaces
72+-- Methods of this class try to mimic "Data.Attoparsec.Text" interface.
73+class ( SemiIsoAlternative syn
77+ => Syntax syn seq | syn -> seq
81+ anyChar :: syn (Element seq)
83+ -- | A specific character.
84+ char :: Element seq -> syn ()
85+ char c = exact c /$/ anyChar
87+ -- | Any character except the given one.
88+ notChar :: Element seq -> syn (Element seq)
89+ notChar c = filtered (/= c) /$/ anyChar
91+ -- | Any character satisfying a predicate.
92+ satisfy :: (Element seq -> Bool) -> syn (Element seq)
93+ satisfy p = filtered p /$/ anyChar
95+ -- | Transforms a character using a SemiIso and filters out values
96+ -- not satisfying the predicate.
97+ satisfyWith :: ASemiIso' a (Element seq) -> (a -> Bool) -> syn a
98+ satisfyWith ai p = filtered p . ai /$/ anyChar
100+ -- | A specific string.
101+ string :: seq -> syn ()
102+ string s = exact s /$/ take (olength s)
104+ -- | A string of length @n@.
105+ take :: Int -> syn seq
106+ take n = packed /$/ sireplicate n anyChar
108+ -- | Maximal string which elements satisfy a predicate.
109+ takeWhile :: (Element seq -> Bool) -> syn seq
110+ takeWhile p = packed /$/ simany (satisfy p)
112+ -- | Maximal non-empty string which elements satisfy a predicate.
113+ takeWhile1 :: (Element seq -> Bool) -> syn seq
114+ takeWhile1 p = packed /$/ sisome (satisfy p)
116+ -- | Maximal string which elements do not satisfy a predicate.
117+ takeTill :: (Element seq -> Bool) -> syn seq
118+ takeTill p = takeWhile (not . p)
120+ -- | Maximal non-empty string which elements do not satisfy a predicate.
121+ takeTill1 :: (Element seq -> Bool) -> syn seq
122+ takeTill1 p = takeWhile1 (not . p)
124+ {-# MINIMAL anyChar #-}