git.iko.soy/syntax
on master help sign in
swap
64f67b715 ahead, 0 behind
Data/Syntax.hs+122−30
since splitsnapshots
unifiedsplit
@@ -1,7 +1,6 @@
1+{-# LANGUAGE TypeFamilies #-}
1{-# LANGUAGE FlexibleContexts #-}
2{-# LANGUAGE FlexibleContexts #-}
2{-# LANGUAGE DefaultSignatures #-}
3{-# LANGUAGE DefaultSignatures #-}
3−{-# LANGUAGE MultiParamTypeClasses #-}
4−{-# LANGUAGE FunctionalDependencies #-}
5{- |
4{- |
6Module : Data.Syntax
5Module : Data.Syntax
7Description : Abstract syntax description.
6Description : Abstract syntax description.
@@ -11,22 +10,28 @@ License : MIT
11Maintainer : Paweł Nowak <pawel834@gmail.com>
10Maintainer : Paweł Nowak <pawel834@gmail.com>
12Stability : experimental
11Stability : experimental
13
12
14−Abstract syntax descriptions based on semi-isomorphisms.
13+Reversible parsing and pretty-printing.
15-}
14-}
16module Data.Syntax (
15module Data.Syntax (
17 -- * Syntax.
16 -- * Syntax.
18 Syntax(..),
17 Syntax(..),
18+ Isolable(..),
19 -- * Common isomorphisms.
19 -- * Common isomorphisms.
20 packed
20 packed
21 ) where
21 ) where
22
22
23−import Prelude hiding (take, takeWhile)
23+import Prelude hiding (take, takeWhile, id, (.))
24
24
25+import Control.Category
26+import Control.Category.Reader
27+import Control.Category.Structures
25−import Control.Lens.Iso
28+import Control.Lens.Iso
26−import Control.Lens.SemiIso
29+import Control.Lens.SemiIso
30+import Control.SIArrow
27−import Data.MonoTraversable
31+import Data.MonoTraversable
28−import Data.SemiIsoFunctor
29−import Data.Sequences hiding (take, takeWhile)
32+import Data.Sequences hiding (take, takeWhile, replicate)
33+import qualified Data.Vector as V
34+import qualified Data.Vector.Unboxed as VU
30
35
31-- | An isomorphism between a sequence and a list of its elements.
36-- | An isomorphism between a sequence and a list of its elements.
32packed :: IsSequence seq => Iso' seq [Element seq]
37packed :: IsSequence seq => Iso' seq [Element seq]
@@ -34,63 +39,150 @@ packed = iso otoList fromList
34
39
35-- | An abstract syntax description based on semi-isomorphisms.
40-- | An abstract syntax description based on semi-isomorphisms.
36--
41--
37−-- This class can be implemented by both parsers and printers (and maybe more?).
42+-- This class can be implemented by both parsers and printers.
38−--
43+--
39-- The usual use is to write a polymorphic syntax description and instantiate it
44-- The usual use is to write a polymorphic syntax description and instantiate it
40−-- both as a parser and a printer. An example is available in the 'syntax-example'
45+-- both as a parser and a printer. Examples are available in 'syntax-example' and
41−-- package.
46+-- 'syntax-example-json' packages.
42--
47--
43-- Methods of this class try to mimic "Data.Attoparsec.Text" interface.
48-- Methods of this class try to mimic "Data.Attoparsec.Text" interface.
44−class ( SemiIsoAlternative syn
49+class ( SIArrow syn
45− , SemiIsoMonad syn
46− , IsSequence seq
50+ , IsSequence (Seq syn)
47− , Eq seq
51+ , Eq (Seq syn)
48− , Eq (Element seq))
52+ , Eq (Element (Seq syn)))
49− => Syntax syn seq | syn -> seq
53+ => Syntax syn
50 where
54 where
55+ -- | The sequence type used by this syntax.
56+ type Seq syn :: *
51
57
52 -- | Any character.
58 -- | Any character.
53− anyChar :: syn (Element seq)
59+ anyChar :: syn () (Element (Seq syn))
54
60
55 -- | A specific character.
61 -- | A specific character.
56− char :: Element seq -> syn ()
62+ char :: Element (Seq syn) -> syn () ()
57 char c = rev (exact c) /$/ anyChar
63 char c = rev (exact c) /$/ anyChar
58
64
59 -- | Any character except the given one.
65 -- | Any character except the given one.
60− notChar :: Element seq -> syn (Element seq)
66+ notChar :: Element (Seq syn) -> syn () (Element (Seq syn))
61 notChar c = bifiltered (/= c) /$/ anyChar
67 notChar c = bifiltered (/= c) /$/ anyChar
62
68
63 -- | Any character satisfying a predicate.
69 -- | Any character satisfying a predicate.
64− satisfy :: (Element seq -> Bool) -> syn (Element seq)
70+ satisfy :: (Element (Seq syn) -> Bool) -> syn () (Element (Seq syn))
65 satisfy p = bifiltered p /$/ anyChar
71 satisfy p = bifiltered p /$/ anyChar
66
72
67 -- | Transforms a character using a SemiIso and filters out values
73 -- | Transforms a character using a SemiIso and filters out values
68 -- not satisfying the predicate.
74 -- not satisfying the predicate.
69− satisfyWith :: ASemiIso' a (Element seq) -> (a -> Bool) -> syn a
75+ satisfyWith :: ASemiIso' a (Element (Seq syn)) -> (a -> Bool) -> syn () a
70 satisfyWith ai p = bifiltered p . ai /$/ anyChar
76 satisfyWith ai p = bifiltered p . ai /$/ anyChar
71
77
72 -- | A specific string.
78 -- | A specific string.
73− string :: seq -> syn ()
79+ string :: Seq syn -> syn () ()
74 string s = rev (exact s) /$/ take (olength s)
80 string s = rev (exact s) /$/ take (olength s)
75
81
76 -- | A string of length @n@.
82 -- | A string of length @n@.
77− take :: Int -> syn seq
83+ take :: Int -> syn () (Seq syn)
78 take n = packed /$/ sireplicate n anyChar
84 take n = packed /$/ sireplicate n anyChar
79
85
80 -- | Maximal string which elements satisfy a predicate.
86 -- | Maximal string which elements satisfy a predicate.
81− takeWhile :: (Element seq -> Bool) -> syn seq
87+ takeWhile :: (Element (Seq syn) -> Bool) -> syn () (Seq syn)
82 takeWhile p = packed /$/ simany (satisfy p)
88 takeWhile p = packed /$/ simany (satisfy p)
83
89
84 -- | Maximal non-empty string which elements satisfy a predicate.
90 -- | Maximal non-empty string which elements satisfy a predicate.
85− takeWhile1 :: (Element seq -> Bool) -> syn seq
91+ takeWhile1 :: (Element (Seq syn) -> Bool) -> syn () (Seq syn)
86 takeWhile1 p = packed /$/ sisome (satisfy p)
92 takeWhile1 p = packed /$/ sisome (satisfy p)
87
93
88 -- | Maximal string which elements do not satisfy a predicate.
94 -- | Maximal string which elements do not satisfy a predicate.
89− takeTill :: (Element seq -> Bool) -> syn seq
95+ takeTill :: (Element (Seq syn) -> Bool) -> syn () (Seq syn)
90 takeTill p = takeWhile (not . p)
96 takeTill p = takeWhile (not . p)
91
97
92 -- | Maximal non-empty string which elements do not satisfy a predicate.
98 -- | Maximal non-empty string which elements do not satisfy a predicate.
93− takeTill1 :: (Element seq -> Bool) -> syn seq
99+ takeTill1 :: (Element (Seq syn) -> Bool) -> syn () (Seq syn)
94 takeTill1 p = takeWhile1 (not . p)
100 takeTill1 p = takeWhile1 (not . p)
95
101
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
111+
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)
127+
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
137+
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)
153+
96 {-# MINIMAL anyChar #-}
154 {-# MINIMAL anyChar #-}
155+
156+instance 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
173+
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.
186+class Syntax syn => Isolable syn where
187+ -- | Turns a computation into one executed in an isolated context.
188+ isolate :: syn () b -> syn (Seq syn) b
Data/Syntax/Char.hs+24−17
@@ -1,6 +1,5 @@
1{-# LANGUAGE TypeFamilies #-}
1{-# LANGUAGE TypeFamilies #-}
2{-# LANGUAGE ConstraintKinds #-}
2{-# LANGUAGE ConstraintKinds #-}
3−{-# LANGUAGE MultiParamTypeClasses #-}
4{- |
3{- |
5Module : Data.Syntax.Char
4Module : Data.Syntax.Char
6Description : Char specific combinators.
5Description : Char specific combinators.
@@ -26,12 +25,14 @@ module Data.Syntax.Char (
26 digitHex
25 digitHex
27 ) where
26 ) where
28
27
28+import Control.Category.Reader
29+import Control.Category.Structures
29import Control.Lens.SemiIso
30import Control.Lens.SemiIso
31+import Control.SIArrow
30import Data.Bits
32import Data.Bits
31import Data.Char
33import Data.Char
32import Data.MonoTraversable
34import Data.MonoTraversable
33import Data.Scientific (Scientific)
35import Data.Scientific (Scientific)
34−import Data.SemiIsoFunctor
35import Data.Syntax
36import Data.Syntax
36import Data.Syntax.Combinator
37import Data.Syntax.Combinator
37import Data.Text (Text)
38import Data.Text (Text)
@@ -40,47 +41,53 @@ import Data.Text (Text)
40--
41--
41-- Note: methods of this class do not have default implementations (for now),
42-- Note: methods of this class do not have default implementations (for now),
42-- because their code is quite ugly and already written in most parser libraries.
43-- because their code is quite ugly and already written in most parser libraries.
43−class (Syntax syn seq, Element seq ~ Char) => SyntaxChar syn seq where
44+class (Syntax syn, Element (Seq syn) ~ Char) => SyntaxChar syn where
44 -- | An unsigned decimal number.
45 -- | An unsigned decimal number.
45− decimal :: Integral a => syn a
46+ decimal :: Integral a => syn () a
46
47
47 -- | An unsigned hexadecimal number.
48 -- | An unsigned hexadecimal number.
48− hexadecimal :: (Integral a, Bits a) => syn a
49+ hexadecimal :: (Integral a, Bits a) => syn () a
49
50
50 -- | A signed real number.
51 -- | A signed real number.
51− realFloat :: RealFloat a => syn a
52+ realFloat :: RealFloat a => syn () a
52
53
53 -- | A scientific number.
54 -- | A scientific number.
54− scientific :: syn Scientific
55+ scientific :: syn () Scientific
55
56
56 {-# MINIMAL decimal, hexadecimal, realFloat, scientific #-}
57 {-# MINIMAL decimal, hexadecimal, realFloat, scientific #-}
57
58
59+instance SyntaxChar syn => SyntaxChar (ReaderCT env syn) where
60+ decimal = clift decimal
61+ hexadecimal = clift hexadecimal
62+ scientific = clift scientific
63+ realFloat = clift realFloat
64+
58-- | An useful synonym for SyntaxChars with Text sequences.
65-- | An useful synonym for SyntaxChars with Text sequences.
59−type SyntaxText syn = SyntaxChar syn Text
66+type SyntaxText syn = (SyntaxChar syn, Seq syn ~ Text)
60
67
61-- | A number with an optional leading '+' or '-' sign character.
68-- | A number with an optional leading '+' or '-' sign character.
62−signed :: (Real a, SyntaxChar syn seq) => syn a -> syn a
69+signed :: (Real a, SyntaxChar syn) => syn () a -> syn () a
63signed n = _Negative /$/ char '-' */ n
70signed n = _Negative /$/ char '-' */ n
64− /|/ opt_ (char '+') */ n
71+ /+/ opt_ (char '+') */ n
65
72
66-- | Accepts zero or more spaces. Generates a single space.
73-- | Accepts zero or more spaces. Generates a single space.
67−spaces :: SyntaxChar syn seq => syn ()
74+spaces :: SyntaxChar syn => syn () ()
68spaces = opt spaces1
75spaces = opt spaces1
69
76
70-- | Accepts zero or more spaces. Generates no output.
77-- | Accepts zero or more spaces. Generates no output.
71−spaces_ :: SyntaxChar syn seq => syn ()
78+spaces_ :: SyntaxChar syn => syn () ()
72spaces_ = opt_ spaces1
79spaces_ = opt_ spaces1
73
80
74-- | Accepts one or more spaces. Generates a single space.
81-- | Accepts one or more spaces. Generates a single space.
75−spaces1 :: SyntaxChar syn seq => syn ()
82+spaces1 :: SyntaxChar syn => syn () ()
76spaces1 = constant (opoint ' ') /$/ takeWhile1 isSpace
83spaces1 = constant (opoint ' ') /$/ takeWhile1 isSpace
77
84
78-- | Accepts a single newline. Generates a newline.
85-- | Accepts a single newline. Generates a newline.
79−endOfLine :: SyntaxChar syn seq => syn ()
86+endOfLine :: SyntaxChar syn => syn () ()
80endOfLine = char '\n'
87endOfLine = char '\n'
81
88
82-- | A decimal digit.
89-- | A decimal digit.
83−digitDec :: SyntaxChar syn seq => syn Int
90+digitDec :: SyntaxChar syn => syn () Int
84digitDec = semiIso toChar toInt /$/ anyChar
91digitDec = semiIso toChar toInt /$/ anyChar
85 where toInt c | isDigit c = Right (digitToInt c)
92 where toInt c | isDigit c = Right (digitToInt c)
86 | otherwise = Left ("Expected a decimal digit, got " ++ [c])
93 | otherwise = Left ("Expected a decimal digit, got " ++ [c])
@@ -88,7 +95,7 @@ digitDec = semiIso toChar toInt /$/ anyChar
88 | otherwise = Left ("Expected a decimal digit, got number " ++ show i)
95 | otherwise = Left ("Expected a decimal digit, got number " ++ show i)
89
96
90-- | An octal digit.
97-- | An octal digit.
91−digitOct :: SyntaxChar syn seq => syn Int
98+digitOct :: SyntaxChar syn => syn () Int
92digitOct = semiIso toChar toInt /$/ anyChar
99digitOct = semiIso toChar toInt /$/ anyChar
93 where toInt c | isOctDigit c = Right (digitToInt c)
100 where toInt c | isOctDigit c = Right (digitToInt c)
94 | otherwise = Left ("Expected an octal digit, got " ++ [c])
101 | otherwise = Left ("Expected an octal digit, got " ++ [c])
@@ -96,7 +103,7 @@ digitOct = semiIso toChar toInt /$/ anyChar
96 | otherwise = Left ("Expected an octal digit, got number " ++ show i)
103 | otherwise = Left ("Expected an octal digit, got number " ++ show i)
97
104
98-- | A hex digit.
105-- | A hex digit.
99−digitHex :: SyntaxChar syn seq => syn Int
106+digitHex :: SyntaxChar syn => syn () Int
100digitHex = semiIso toChar toInt /$/ anyChar
107digitHex = semiIso toChar toInt /$/ anyChar
101 where toInt c | isHexDigit c = Right (digitToInt c)
108 where toInt c | isHexDigit c = Right (digitToInt c)
102 | otherwise = Left ("Expected a hex digit, got " ++ [c])
109 | otherwise = Left ("Expected a hex digit, got " ++ [c])
Data/Syntax/Combinator.hs+161−23
@@ -1,3 +1,6 @@
1+{-# LANGUAGE RankNTypes #-}
2+{-# LANGUAGE ScopedTypeVariables #-}
3+{-# LANGUAGE FlexibleContexts #-}
1{- |
4{- |
2Module : Data.Syntax.Combinator
5Module : Data.Syntax.Combinator
3Description : Combinators that work with any sequence type.
6Description : Combinators that work with any sequence type.
@@ -9,44 +12,179 @@ Stability : experimental
9
12
10Combinators that work with any sequence type.
13Combinators that work with any sequence type.
11-}
14-}
12−module Data.Syntax.Combinator where
15+module Data.Syntax.Combinator
16+ (
17+ -- * Combinators.
18+ optional,
19+ opt,
20+ opt_,
21+ choice,
22+ eitherOf,
13
23
14−import Control.Lens
24+ -- * Lists.
25+ manyTill,
26+ sepBy,
27+ sepBy1,
28+
29+ -- * Arrowized combinators.
30+ takeArr,
31+
32+ -- * Vectors.
33+ vecNSepBy,
34+ ivecNSepBy,
35+ vec,
36+ vecSepBy,
37+ ivec,
38+ ivecSepBy,
39+
40+ -- * Unboxed vectors.
41+ uvecNSepBy,
42+ uivecNSepBy,
43+ uvec,
44+ uvecSepBy,
45+ uivec,
46+ uivecSepBy
47+ ) where
48+
49+import Control.Category
50+import Control.Category.Structures
51+import Control.Lens
15−import Control.Lens.SemiIso
52+import Control.Lens.SemiIso
16−import Data.SemiIsoFunctor
53+import Control.SIArrow
54+import qualified Data.MonoTraversable as Seq
55+import Data.Syntax
56+import qualified Data.Vector as V
57+import qualified Data.Vector.Unboxed as VU
58+import Prelude hiding (id, (.), take)
17
59
18-- | One or zero occurences of @f@.
60-- | One or zero occurences of @f@.
19−optional :: SemiIsoAlternative f => f a -> f (Maybe a)
61+optional :: SIArrow cat => cat () a -> cat () (Maybe a)
20−optional f = _Just /$/ f /|/ sipure _Nothing
62+optional f = _Just /$/ f /+/ sipure _Nothing
21
63
22-- | Like 'optional', but specialized for @()@.
64-- | Like 'optional', but specialized for @()@.
23−opt :: SemiIsoAlternative f => f () -> f ()
65+opt :: SIArrow cat => cat () () -> cat () ()
24−opt f = f /|/ sipure id
66+opt f = f /+/ sipure id
25
67
26-- | Parser one or zero occurences of @f@, but prints nothing.
68-- | Parser one or zero occurences of @f@, but prints nothing.
27−opt_ :: SemiIsoAlternative f => f () -> f ()
69+opt_ :: SIArrow cat => cat () () -> cat () ()
28opt_ f = semiIso (const (Left "opt_")) Right /$/ f
70opt_ f = semiIso (const (Left "opt_")) Right /$/ f
29− /|/ sipure id
71+ /+/ sipure id
72+
73+-- | Tries to apply the actions in the list in order, until one of
74+-- them succeeds. Returns the value of the succeeding action.
75+choice :: SIArrow cat => [cat () a] -> cat () a
76+choice = foldr (/+/) (sifail "choice: all alternatives failed")
77+
78+-- | Combine two alternatives.
79+eitherOf :: SIArrow cat => cat () a -> cat () b -> cat () (Either a b)
80+eitherOf a b = _Left /$/ a /+/ _Right /$/ b
30
81
31-- | @manyTill p end@ applies action p zero or more times until action
82-- | @manyTill p end@ applies action p zero or more times until action
32-- end succeeds, and returns the list of values returned by p.
83-- end succeeds, and returns the list of values returned by p.
33−manyTill :: SemiIsoAlternative f => f a -> f () -> f [a]
84+manyTill :: SIArrow cat => cat () a -> cat () () -> cat () [a]
34manyTill p end = _Empty /$/ end
85manyTill p end = _Empty /$/ end
35− /|/ _Cons /$/ p /*/ manyTill p end
86+ /+/ _Cons /$/ p /*/ manyTill p end
36
87
37-- | Zero or more occurences of @v@ separated by @s@.
88-- | Zero or more occurences of @v@ separated by @s@.
38−sepBy :: SemiIsoAlternative f => f a -> f () -> f [a]
89+sepBy :: SIArrow cat => cat () a -> cat () () -> cat () [a]
39−sepBy v s = sepBy1 v s /|/ sipure _Empty
90+sepBy v s = sepBy1 v s /+/ sipure _Empty
40
91
41-- | One or more occurences of @v@ separated by @s@.
92-- | One or more occurences of @v@ separated by @s@.
42−sepBy1 :: SemiIsoAlternative f => f a -> f () -> f [a]
93+sepBy1 :: SIArrow cat => cat () a -> cat () () -> cat () [a]
43−sepBy1 v s = _Cons /$/ v /*/ (s */ sepBy1 v s /|/ sipure _Empty)
94+sepBy1 v s = _Cons /$/ v /*/ (s */ sepBy1 v s /+/ sipure _Empty)
44
95
45−-- | Tries to apply the actions in the list in order, until one of
96+-- | A string of given length.
46−-- them succeeds. Returns the value of the succeeding action.
97+takeArr :: Syntax syn => syn Int (Seq syn)
47−choice :: SemiIsoAlternative f => [f a] -> f a
98+takeArr = sibind $ iso (\n -> constant n #>> take n)
48−choice = foldr (/|/) (sifail "choice: all alternatives failed")
99+ (\s -> constant (Seq.olength s) #>> take (Seq.olength s))
49
100
50−-- | Combine two alternatives.
101+-- | Constant size vector with separators.
51−eitherOf :: SemiIsoAlternative f => f a -> f b -> f (Either a b)
102+--
52−eitherOf a b = _Left /$/ a /|/ _Right /$/ b
103+-- @vecNSepBy n e sep@ describes a size @n@ vector with elements @e@ separated by @sep@.
104+vecNSepBy :: Syntax syn => Int -> syn () a -> syn () () -> syn () (V.Vector a)
105+vecNSepBy n e sep = ivecNSepBy n (unit ^>> second e) sep
106+
107+-- | Constant size vector with separators and index-aware elements.
108+--
109+-- @ivecNSepBy n e sep@ describes a size @n@ vector with elements @e@ separated by @sep@.
110+-- Each element gets its index and should output a value and the index unchanged.
111+ivecNSepBy :: Syntax syn => Int -> syn Int (Int, a) -> syn () () -> syn () (V.Vector a)
112+ivecNSepBy n e sep = ivecN n $ sibind $ iso el (el . fst)
113+ where
114+ el k | k < n - 1 = unit ^>> e *** sep >># unit
115+ | otherwise = e
116+
117+-- | Runtime sized vector. The size can depend on the result of some computation.
118+--
119+-- @vec e@ describes a vector with elements @e@.
120+vec :: Syntax syn => syn () a -> syn Int (V.Vector a)
121+vec e = vecSepBy e (siarr id)
122+
123+-- | Runtime sized vector with separators. The size can depend on the result of some
124+-- computation.
125+--
126+-- @vecSepBy e sep@ describes a vector with elements @e@ separated by @sep@.
127+vecSepBy :: Syntax syn => syn () a -> syn () () -> syn Int (V.Vector a)
128+vecSepBy e sep = ivecSepBy (unit ^>> second e) sep
129+
130+-- | Runtime sized vector with index-aware elements. The size can depend on the result
131+-- of some computation.
132+--
133+-- @ivec e@ describes a vector with elements @e@.
134+ivec :: Syntax syn => syn Int (Int, a) -> syn Int (V.Vector a)
135+ivec e = ivecSepBy e (siarr id)
136+
137+-- | Runtime sized vector with index-aware elements and separators. The size can depend
138+-- on the result of some computation.
139+--
140+-- @ivecSepBy e sep@ describes a vector with elements @e@ separated by @sep@.
141+ivecSepBy :: Syntax syn => syn Int (Int, a) -> syn () () -> syn Int (V.Vector a)
142+ivecSepBy e sep = sibind $ iso (\n -> constant n #>> ivecNSepBy n e sep)
143+ (\v -> constant (V.length v) #>> ivecNSepBy (V.length v) e sep)
144+
145+-- | Constant size unboxed vector with separators.
146+--
147+-- @uvecNSepBy n e sep@ describes a size @n@ vector with elements @e@ separated by @sep@.
148+uvecNSepBy :: (Syntax syn, VU.Unbox a) => Int -> syn () a -> syn () () -> syn () (VU.Vector a)
149+uvecNSepBy n e sep = uivecNSepBy n (unit ^>> second e) sep
150+
151+-- | Constant size unboxed vector with separators and index-aware elements.
152+--
153+-- @uivecNSepBy n e sep@ describes a size @n@ vector with elements @e@ separated by @sep@.
154+-- Each element gets its index and should output a value and the index unchanged.
155+uivecNSepBy :: (Syntax syn, VU.Unbox a) => Int -> syn Int (Int, a)
156+ -> syn () () -> syn () (VU.Vector a)
157+uivecNSepBy n e sep = uivecN n $ sibind $ iso el (el . fst)
158+ where
159+ el k | k < n - 1 = unit ^>> e *** sep >># unit
160+ | otherwise = e
161+
162+-- | Runtime sized unboxed vector. The size can depend on the result of some computation.
163+--
164+-- @uvec e@ describes a vector with elements @e@.
165+uvec :: (Syntax syn, VU.Unbox a) => syn () a -> syn Int (VU.Vector a)
166+uvec e = uvecSepBy e (siarr id)
167+
168+-- | Runtime sized unboxed vector with separators. The size can depend on the result of some
169+-- computation.
170+--
171+-- @uvecSepBy e sep@ describes a vector with elements @e@ separated by @sep@.
172+uvecSepBy :: (Syntax syn, VU.Unbox a) => syn () a -> syn () () -> syn Int (VU.Vector a)
173+uvecSepBy e sep = uivecSepBy (unit ^>> second e) sep
174+
175+-- | Runtime sized unboxed vector with index-aware elements. The size can depend on the result
176+-- of some computation.
177+--
178+-- @uivec e@ describes a vector with elements @e@.
179+uivec :: (Syntax syn, VU.Unbox a) => syn Int (Int, a) -> syn Int (VU.Vector a)
180+uivec e = uivecSepBy e (siarr id)
181+
182+-- | Runtime sized unboxed vector with index-aware elements and separators. The size can depend
183+-- on the result of some computation.
184+--
185+-- @uivecSepBy e sep@ describes a vector with elements @e@ separated by @sep@.
186+uivecSepBy :: (Syntax syn, VU.Unbox a) => syn Int (Int, a)
187+ -> syn () () -> syn Int (VU.Vector a)
188+uivecSepBy e sep = sibind $ iso (\n -> constant n #>> uivecNSepBy n e sep)
189+ (\v -> constant (VU.length v)
190+ #>> uivecNSepBy (VU.length v) e sep)
Data/Syntax/Indent.hs+39−43
@@ -1,16 +1,16 @@
1+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
1{-# LANGUAGE FlexibleInstances #-}
2{-# LANGUAGE FlexibleInstances #-}
2−{-# LANGUAGE UndecidableInstances #-}
3+{-# LANGUAGE TypeFamilies #-}
3−{-# LANGUAGE MultiParamTypeClasses #-}
4{- |
4{- |
5Module : Data.Syntax.Indent
5Module : Data.Syntax.Indent
6−Description : Indentation.
6+Description : Simple indentation.
7Copyright : (c) Paweł Nowak
7Copyright : (c) Paweł Nowak
8License : MIT
8License : MIT
9
9
10Maintainer : Paweł Nowak <pawel834@gmail.com>
10Maintainer : Paweł Nowak <pawel834@gmail.com>
11Stability : experimental
11Stability : experimental
12
12
13−Provides a very simple indentation as a \"monad\" transformer.
13+Provides a very simple indentation as a category transformer.
14-}
14-}
15module Data.Syntax.Indent (
15module Data.Syntax.Indent (
16 Indent,
16 Indent,
@@ -19,59 +19,55 @@ module Data.Syntax.Indent (
19 indented
19 indented
20 ) where
20 ) where
21
21
22−import Data.SemiIsoFunctor
22+import Control.Category
23+import Control.Category.Reader
24+import Control.Category.Structures
25+import Control.SIArrow
23import Data.Syntax
26import Data.Syntax
24import Data.Syntax.Char
27import Data.Syntax.Char
25import Data.Syntax.Combinator
28import Data.Syntax.Combinator
26−import Prelude hiding (takeWhile, take)
29+import Prelude hiding (takeWhile, take, id, (.))
27
30
28-- | Adds indentation to a syntax description.
31-- | Adds indentation to a syntax description.
29−newtype Indent m a = Indent { unIndent :: (Int, m ()) -> m a }
32+newtype Indent cat a b = Indent { getIndent :: ReaderCT (Int, cat () ()) cat a b }
33+ deriving (Category, Products, Coproducts, CatPlus, SIArrow)
30
34
31−instance SemiIsoFunctor m => SemiIsoFunctor (Indent m) where
35+instance CatTrans Indent where
32− simap f (Indent g) = Indent $ \i -> simap f (g i)
36+ clift = Indent . clift
33
37
34−instance SemiIsoApply m => SemiIsoApply (Indent m) where
38+-- Generalized newtype deriving cannot derive this :(
35− sipure ai = Indent $ \_ -> sipure ai
36− Indent f /*/ Indent g = Indent $ \i -> f i /*/ g i
37
39
38−instance SemiIsoAlternative m => SemiIsoAlternative (Indent m) where
40+instance Syntax syn => Syntax (Indent syn) where
39− siempty = Indent $ \_ -> siempty
41+ type Seq (Indent syn) = Seq syn
40− Indent f /|/ Indent g = Indent $ \i -> f i /|/ g i
42+ anyChar = Indent anyChar
43+ char = Indent . char
44+ notChar = Indent . notChar
45+ satisfy = Indent . satisfy
46+ satisfyWith ai = Indent . satisfyWith ai
47+ string = Indent . string
48+ take = Indent . take
49+ takeWhile = Indent . takeWhile
50+ takeWhile1 = Indent . takeWhile1
51+ takeTill = Indent . takeTill
52+ takeTill1 = Indent . takeTill1
41
53
42−instance SemiIsoMonad m => SemiIsoMonad (Indent m) where
54+instance SyntaxChar syn => SyntaxChar (Indent syn) where
43− (Indent m) //= f = Indent $ \i -> m i //= (\x -> unIndent (f x) i)
55+ decimal = Indent decimal
44−
56+ hexadecimal = Indent hexadecimal
45−instance SemiIsoFix m => SemiIsoFix (Indent m) where
57+ scientific = Indent scientific
46− sifix f = Indent $ \i -> sifix $ \y -> unIndent (f y) i
58+ realFloat = Indent realFloat
47−
48−instance Syntax syn seq => Syntax (Indent syn) seq where
49− anyChar = Indent $ const anyChar
50− char = Indent . const . char
51− notChar = Indent . const . notChar
52− satisfy = Indent . const . satisfy
53− satisfyWith ai = Indent . const . satisfyWith ai
54− string = Indent . const . string
55− take = Indent . const . take
56− takeWhile = Indent . const . takeWhile
57− takeWhile1 = Indent . const . takeWhile1
58− takeTill = Indent . const . takeTill
59− takeTill1 = Indent . const . takeTill1
60−
61−instance SyntaxChar syn seq => SyntaxChar (Indent syn) seq where
62− decimal = Indent $ const decimal
63− scientific = Indent $ const scientific
64
59
65-- | @runIndent m tab@ runs the 'Indent' transformer using @tab@ once for each
60-- | @runIndent m tab@ runs the 'Indent' transformer using @tab@ once for each
66-- level of indentation.
61-- level of indentation.
67−runIndent :: Indent m a -> m () -> m a
62+runIndent :: Indent cat a b -> cat () () -> cat a b
68−runIndent = ($ 0) . curry . unIndent
63+runIndent (Indent m) tab = runReaderCT m (0, tab)
69
64
70-- | Inserts a new line and correct indentation, but does not
65-- | Inserts a new line and correct indentation, but does not
71-- require any formatting when parsing (it just skips all white space).
66-- require any formatting when parsing (it just skips all white space).
72−breakLine :: SyntaxChar syn seq => Indent syn ()
67+breakLine :: SyntaxChar syn => Indent syn () ()
68+breakLine = Indent . ReaderCT $ \(i, tab) ->
73−breakLine = Indent $ \(i, tab) -> opt (char '\n') /* opt (sireplicate_ i tab) /* spaces_
69+ opt (char '\n') /* opt (sireplicate_ i tab) /* spaces_
74
70
75-- | Increases the indentation level of its argument by one.
71-- | Increases the indentation level of its argument by one.
76−indented :: Indent m a -> Indent m a
72+indented :: Indent cat a b -> Indent cat a b
77−indented (Indent f) = Indent $ \(i, tab) -> f (i + 1, tab)
73+indented (Indent f) = Indent . ReaderCT $ \(i, tab) -> runReaderCT f (i + 1, tab)
syntax.cabal+23−23
@@ -1,35 +1,35 @@
1name: syntax
1name: syntax
2−version: 0.3.0.0
2+version: 1.0.0.0
3−synopsis: Syntax descriptions for unified parsing and pretty-printing.
3+synopsis: Reversible parsing and pretty-printing.
4description:
4description:
5− 'syntax' allows you to write a single syntax description and instantiate is both as a parser and a pretty printer.
5+ "syntax" allows you to write a single syntax description and instantiate is both as a parser and a pretty printer.
6 .
6 .
7− The interface is based on a custom Functor\/Applicative\/Monad hierarchy, provided by the 'semi-iso' package. You fmap using
7+ Syntax descriptions are written in applicative or arrow style. The library uses a custom typeclass hierarchy, provided
8− a semi-isomorphism instead of function. A semi-isomorphism is a isomorphism that can fail in both directions, with slightly
8+ by the "semi-iso" package. Most of the time you will be using operators like '/$/', '/*/' and '/+/' (= '<|>'), just
9− weakened laws. It is worth to note that @Iso@s and @Prism@s from 'lens' are valid semi-isomorphisms :)
9+ like parser combinators. When more power is needed - e.g. when the syntax depends on the parsed or printed value -
10+ you turn to arrows.
10 .
11 .
11− Once you write a description you can, for example turn it into an Attoparsec parser.
12+ Semi-isomorphisms from "semi-iso" are the basic building block of syntax descriptions. I recommend reading
13+ the hackage page of "semi-iso" first, as it contains much more information.
12 .
14 .
13− See @syntax-example@ and @syntax-example-json@ for examples, 'syntax-attoparsec' and 'syntax-pretty' for a parser/printer implementation.
15+ Once you write a syntax description (polymorphic in the syntax category) you can instantiate it both as a parser or as
16+ a pretty-printer. The library "syntax-attoparsec" gives you the ability to extract an Attoparsec parser. Pretty-printing
17+ is implemented by the "syntax-printer" library, which uses Text and ByteString builders. (Note that formatting is handled
18+ by "syntax" itself, not by the printer library)
14 .
19 .
15− The library was inspired by:
20+ Advanced formatting and parsing (for example indentation, haskell layout rule) is implemented as category transformers
21+ (similar to monad transformers). Currently only simple indentation is implemented (in "Data.Syntax.Indent") - basically
22+ a reader category transformer that tracks current indentation level. I plan on implementing Haskell layout rule in the
23+ future.
16 .
24 .
17− * Rendel, Tillmann, and Klaus Ostermann. "Invertible syntax descriptions: unifying parsing and pretty printing." ACM Sigplan Notices. Vol. 45. No. 11. ACM, 2010.
25+ The library can work with both text and binary data. Alas, there are no binary combinators implemented yet.
26+ I will implement them when i have the time (but these category transformers look so much more interesting for now ;).
18 .
27 .
19− TODO:
28+ EXAMPLES! See @syntax-example@ and @syntax-example-json@ for examples.
20 .
29 .
21− * A printer library based on Text/ByteString builders (wrapping 'pretty' is inefficient and doesn't use any features of it).
30+ * "syntax-example" implements a simple lambda calculus.
22 .
31 .
23− * Research relative monads and relative monad transformers. Indent is basically a Reader monad over a syntax. How would a State monad look?
32+ * "syntax-example-json" implements a json parser and pretty printer.
24− .
25− * Try to implement Haskell layout rule.
26− .
27− * Combinators for binary data formats, vectors.
28− .
29− * Better error messages.
30− .
31− * Maybe an implementation of do notation for SemiIsoMonad with QuasiQuoters.
32−
33license: MIT
33license: MIT
34license-file: LICENSE
34license-file: LICENSE
35author: Paweł Nowak
35author: Paweł Nowak
@@ -48,5 +48,5 @@ library
48 Data.Syntax.Char
48 Data.Syntax.Char
49 Data.Syntax.Combinator
49 Data.Syntax.Combinator
50 Data.Syntax.Indent
50 Data.Syntax.Indent
51− build-depends: base >= 4 && < 5, mono-traversable, lens >= 4, semi-iso >= 0.5.0, scientific >= 0.3, text
51+ build-depends: base >= 4 && < 5, mono-traversable, lens >= 4, semi-iso >= 1, scientific >= 0.3, text, vector
52 default-language: Haskell2010
52 default-language: Haskell2010