on master help sign in
syntax/Data/Syntax.hs
188 lines 7.3 kB history raw
1{-# LANGUAGE TypeFamilies #-}
2{-# LANGUAGE FlexibleContexts #-}
3{-# LANGUAGE DefaultSignatures #-}
4{- |
5Module : Data.Syntax
6Description : Abstract syntax description.
7Copyright : (c) Paweł Nowak
8License : MIT
10Maintainer : Paweł Nowak <pawel834@gmail.com>
11Stability : experimental
13Reversible parsing and pretty-printing.
14-}
15module Data.Syntax (
16 -- * Syntax.
17 Syntax(..),
18 Isolable(..),
19 -- * Common isomorphisms.
20 packed
21 ) where
23import Prelude hiding (take, takeWhile, id, (.))
25import Control.Category
26import Control.Category.Reader
27import Control.Category.Structures
28import Control.Lens.Iso
29import Control.Lens.SemiIso
30import Control.SIArrow
31import Data.MonoTraversable
32import Data.Sequences hiding (take, takeWhile, replicate)
33import qualified Data.Vector as V
34import qualified Data.Vector.Unboxed as VU
36-- | An isomorphism between a sequence and a list of its elements.
37packed :: IsSequence seq => Iso' seq [Element seq]
38packed = iso otoList fromList
40-- | An abstract syntax description based on semi-isomorphisms.
41--
42-- This class can be implemented by both parsers and printers.
43--
44-- The usual use is to write a polymorphic syntax description and instantiate it
45-- both as a parser and a printer. Examples are available in 'syntax-example' and
46-- 'syntax-example-json' packages.
47--
48-- Methods of this class try to mimic "Data.Attoparsec.Text" interface.
49class ( SIArrow syn
50 , IsSequence (Seq syn)
51 , Eq (Seq syn)
52 , Eq (Element (Seq syn)))
53 => Syntax syn
54 where
55 -- | The sequence type used by this syntax.
56 type Seq syn :: *
58 -- | Any character.
59 anyChar :: syn () (Element (Seq syn))
61 -- | A specific character.
62 char :: Element (Seq syn) -> syn () ()
63 char c = rev (exact c) /$/ anyChar
65 -- | Any character except the given one.
66 notChar :: Element (Seq syn) -> syn () (Element (Seq syn))
67 notChar c = bifiltered (/= c) /$/ anyChar
69 -- | Any character satisfying a predicate.
70 satisfy :: (Element (Seq syn) -> Bool) -> syn () (Element (Seq syn))
71 satisfy p = bifiltered p /$/ anyChar
73 -- | Transforms a character using a SemiIso and filters out values
74 -- not satisfying the predicate.
75 satisfyWith :: ASemiIso' a (Element (Seq syn)) -> (a -> Bool) -> syn () a
76 satisfyWith ai p = bifiltered p . ai /$/ anyChar
78 -- | A specific string.
79 string :: Seq syn -> syn () ()
80 string s = rev (exact s) /$/ take (olength s)
82 -- | A string of length @n@.
83 take :: Int -> syn () (Seq syn)
84 take n = packed /$/ sireplicate n anyChar
86 -- | Maximal string which elements satisfy a predicate.
87 takeWhile :: (Element (Seq syn) -> Bool) -> syn () (Seq syn)
88 takeWhile p = packed /$/ simany (satisfy p)
90 -- | Maximal non-empty string which elements satisfy a predicate.
91 takeWhile1 :: (Element (Seq syn) -> Bool) -> syn () (Seq syn)
92 takeWhile1 p = packed /$/ sisome (satisfy p)
94 -- | Maximal string which elements do not satisfy a predicate.
95 takeTill :: (Element (Seq syn) -> Bool) -> syn () (Seq syn)
96 takeTill p = takeWhile (not . p)
98 -- | Maximal non-empty string which elements do not satisfy a predicate.
99 takeTill1 :: (Element (Seq syn) -> Bool) -> syn () (Seq syn)
100 takeTill1 p = takeWhile1 (not . p)
102 -- | Constant size vector. The default implementation uses lists, but
103 -- "syntax-attoparsec" and "syntax-printer" override it with an efficient
104 -- implementation that works on a vector directly.
105 --
106 -- @vecN n e@ describes a size @n@ vector with elements @e@.
107 --
108 -- Also see 'Data.Syntax.Combinator.vec'.
109 vecN :: Int -> syn () a -> syn () (V.Vector a)
110 vecN n e = packed /$/ sireplicate n e
112 -- | Constant size vector with index-aware element. The default implementation
113 -- uses lists, but "syntax-attoparsec" and "syntax-printer" override it with an
114 -- efficient implementation that works on a vector directly.
115 --
116 -- @ivecN n e@ describes a size @n@ vector with elements @e@. Each element
117 -- gets its index and should output a value and the index unchanged.
118 --
119 -- Also see 'Data.Syntax.Combinator.ivec'.
120 ivecN :: Int -> syn Int (Int, a) -> syn () (V.Vector a)
121 ivecN n e = (packed /$/)
122 $ sisequence
123 $ map (\(i, e') -> constant i ^>> e'
124 >>> first (sipure (constant i))
125 >># unit . swapped)
126 $ zip [0 .. n-1] (replicate n e)
128 -- | Constant size unboxed vector. The default implementation uses lists, but
129 -- "syntax-attoparsec" and "syntax-printer" override it with an efficient
130 -- implementation that works on a vector directly.
131 --
132 -- @vecN n e@ describes a size @n@ vector with elements @e@.
133 --
134 -- Also see 'Data.Syntax.Combinator.vec'.
135 uvecN :: VU.Unbox a => Int -> syn () a -> syn () (VU.Vector a)
136 uvecN n e = packed /$/ sireplicate n e
138 -- | Constant size unboxed vector with index-aware element. The default implementation
139 -- uses lists, but "syntax-attoparsec" and "syntax-printer" override it with an
140 -- efficient implementation that works on a vector directly.
141 --
142 -- @ivecN n e@ describes a size @n@ vector with elements @e@. Each element
143 -- gets its index and should output a value and the index unchanged.
144 --
145 -- Also see 'Data.Syntax.Combinator.ivec'.
146 uivecN :: VU.Unbox a => Int -> syn Int (Int, a) -> syn () (VU.Vector a)
147 uivecN n e = (packed /$/)
148 $ sisequence
149 $ map (\(i, e') -> constant i ^>> e'
150 >>> first (sipure (constant i))
151 >># unit . swapped)
152 $ zip [0 .. n-1] (replicate n e)
154 {-# MINIMAL anyChar #-}
156instance Syntax syn => Syntax (ReaderCT env syn) where
157 type Seq (ReaderCT env syn) = Seq syn
158 anyChar = clift anyChar
159 char = clift . char
160 notChar = clift . notChar
161 satisfy = clift . satisfy
162 satisfyWith ai = clift . satisfyWith ai
163 string = clift . string
164 take = clift . take
165 takeWhile = clift . takeWhile
166 takeWhile1 = clift . takeWhile1
167 takeTill = clift . takeTill
168 takeTill1 = clift . takeTill1
169 vecN n e = ReaderCT $ vecN n . runReaderCT e
170 ivecN n e = ReaderCT $ ivecN n . runReaderCT e
171 uvecN n e = ReaderCT $ uvecN n . runReaderCT e
172 uivecN n e = ReaderCT $ uivecN n . runReaderCT e
174-- | Execute a computation in an isolated context.
175--
176-- The motivating example: you want to write a function
177--
178-- > serializeList :: Syntax syn => syn () a -> syn () [a]
179--
180-- Notice that we cannot just use simany, because the first @syn () a@
181-- could eat the entire sequence (even though we printed more than 1 value!), so
182-- we have to insert some kind of separators between the element. But how can we
183-- be sure that @syn () a@ will not eat our separators? We can't! Thats why we
184-- have to do the parsing in two stages: first extract the sequence between separators,
185-- then run the @syn () a@ on this sequence.
186class Syntax syn => Isolable syn where
187 -- | Turns a computation into one executed in an isolated context.
188 isolate :: syn () b -> syn (Seq syn) b