@@ -0,0 +1,124 @@
1+{-# LANGUAGE FlexibleContexts #-}
2+{-# LANGUAGE DefaultSignatures #-}
3+{-# LANGUAGE MultiParamTypeClasses #-}
4+{-# LANGUAGE FunctionalDependencies #-}
5+{- |
6+Module : Data.Syntax
7+Description : Abstract syntax description.
8+Copyright : (c) Paweł Nowak
9+License : MIT
10+
11+Maintainer : Paweł Nowak <pawel834@gmail.com>
12+Stability : experimental
13+
14+Abstract syntax descriptions based on semi-isomorphisms.
15+-}
16+module Data.Syntax (
17+ -- * Syntax.
18+ Syntax(..),
19+ -- * Common isomorphisms.
20+ packed
21+ ) where
22+
23+import Prelude hiding (take, takeWhile)
24+
25+import Control.Lens
26+import Control.Lens.SemiIso
27+import Data.MonoTraversable
28+import Data.SemiIsoFunctor
29+import Data.Sequences hiding (take, takeWhile)
30+
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
34+
35+-- | An abstract syntax description based on semi-isomorphisms.
36+--
37+-- This class can be implemented by both parsers and printers (and maybe more?).
38+--
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:
41+--
42+-- > | A simple untyped lambda calculus.
43+-- > data AST = Var Text
44+-- > | App AST AST
45+-- > | Abs Text AST
46+-- > deriving (Show)
47+-- >
48+-- > $(makePrisms ''AST)
49+-- >
50+-- > -- | A variable name.
51+-- > name :: Syntax syn Text => syn Text
52+-- > name = S.takeWhile1 isAlphaNum
53+-- >
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 ')'
57+-- >
58+-- > -- | An atom is a variable or an expression in parentheses.
59+-- > atom :: Syntax syn Text => syn AST
60+-- > atom = _Var /$/ name
61+-- > /|/ parens expr
62+-- >
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
69+-- > /*/ expr
70+-- > /|/ atom
71+--
72+-- Methods of this class try to mimic "Data.Attoparsec.Text" interface.
73+class ( SemiIsoAlternative syn
74+ , IsSequence seq
75+ , Eq seq
76+ , Eq (Element seq))
77+ => Syntax syn seq | syn -> seq
78+ where
79+
80+ -- | Any character.
81+ anyChar :: syn (Element seq)
82+
83+ -- | A specific character.
84+ char :: Element seq -> syn ()
85+ char c = exact c /$/ anyChar
86+
87+ -- | Any character except the given one.
88+ notChar :: Element seq -> syn (Element seq)
89+ notChar c = filtered (/= c) /$/ anyChar
90+
91+ -- | Any character satisfying a predicate.
92+ satisfy :: (Element seq -> Bool) -> syn (Element seq)
93+ satisfy p = filtered p /$/ anyChar
94+
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
99+
100+ -- | A specific string.
101+ string :: seq -> syn ()
102+ string s = exact s /$/ take (olength s)
103+
104+ -- | A string of length @n@.
105+ take :: Int -> syn seq
106+ take n = packed /$/ sireplicate n anyChar
107+
108+ -- | Maximal string which elements satisfy a predicate.
109+ takeWhile :: (Element seq -> Bool) -> syn seq
110+ takeWhile p = packed /$/ simany (satisfy p)
111+
112+ -- | Maximal non-empty string which elements satisfy a predicate.
113+ takeWhile1 :: (Element seq -> Bool) -> syn seq
114+ takeWhile1 p = packed /$/ sisome (satisfy p)
115+
116+ -- | Maximal string which elements do not satisfy a predicate.
117+ takeTill :: (Element seq -> Bool) -> syn seq
118+ takeTill p = takeWhile (not . p)
119+
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)
123+
124+ {-# MINIMAL anyChar #-}