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