git.iko.soy/syntax
on master help sign in
swap
64f67b742 ahead, 0 behind
Data/Syntax.hsnew file+188
since splitsnapshots
unifiedsplit
@@ -0,0 +1,188 @@
1+{-# LANGUAGE TypeFamilies #-}
2+{-# LANGUAGE FlexibleContexts #-}
3+{-# LANGUAGE DefaultSignatures #-}
4+{- |
5+Module : Data.Syntax
6+Description : Abstract syntax description.
7+Copyright : (c) Paweł Nowak
8+License : MIT
9+
10+Maintainer : Paweł Nowak <pawel834@gmail.com>
11+Stability : experimental
12+
13+Reversible parsing and pretty-printing.
14+-}
15+module Data.Syntax (
16+ -- * Syntax.
17+ Syntax(..),
18+ Isolable(..),
19+ -- * Common isomorphisms.
20+ packed
21+ ) where
22+
23+import Prelude hiding (take, takeWhile, id, (.))
24+
25+import Control.Category
26+import Control.Category.Reader
27+import Control.Category.Structures
28+import Control.Lens.Iso
29+import Control.Lens.SemiIso
30+import Control.SIArrow
31+import Data.MonoTraversable
32+import Data.Sequences hiding (take, takeWhile, replicate)
33+import qualified Data.Vector as V
34+import qualified Data.Vector.Unboxed as VU
35+
36+-- | An isomorphism between a sequence and a list of its elements.
37+packed :: IsSequence seq => Iso' seq [Element seq]
38+packed = iso otoList fromList
39+
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.
49+class ( 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 :: *
57+
58+ -- | Any character.
59+ anyChar :: syn () (Element (Seq syn))
60+
61+ -- | A specific character.
62+ char :: Element (Seq syn) -> syn () ()
63+ char c = rev (exact c) /$/ anyChar
64+
65+ -- | Any character except the given one.
66+ notChar :: Element (Seq syn) -> syn () (Element (Seq syn))
67+ notChar c = bifiltered (/= c) /$/ anyChar
68+
69+ -- | Any character satisfying a predicate.
70+ satisfy :: (Element (Seq syn) -> Bool) -> syn () (Element (Seq syn))
71+ satisfy p = bifiltered p /$/ anyChar
72+
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
77+
78+ -- | A specific string.
79+ string :: Seq syn -> syn () ()
80+ string s = rev (exact s) /$/ take (olength s)
81+
82+ -- | A string of length @n@.
83+ take :: Int -> syn () (Seq syn)
84+ take n = packed /$/ sireplicate n anyChar
85+
86+ -- | Maximal string which elements satisfy a predicate.
87+ takeWhile :: (Element (Seq syn) -> Bool) -> syn () (Seq syn)
88+ takeWhile p = packed /$/ simany (satisfy p)
89+
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)
93+
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)
97+
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)
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+
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.hsnew file+111
@@ -0,0 +1,111 @@
1+{-# LANGUAGE TypeFamilies #-}
2+{-# LANGUAGE ConstraintKinds #-}
3+{- |
4+Module : Data.Syntax.Char
5+Description : Char specific combinators.
6+Copyright : (c) Paweł Nowak
7+License : MIT
8+
9+Maintainer : Paweł Nowak <pawel834@gmail.com>
10+Stability : experimental
11+
12+Common combinators that work with sequences of chars.
13+
14+-}
15+module Data.Syntax.Char (
16+ SyntaxChar(..),
17+ SyntaxText,
18+ signed,
19+ spaces,
20+ spaces_,
21+ spaces1,
22+ endOfLine,
23+ digitDec,
24+ digitOct,
25+ digitHex
26+ ) where
27+
28+import Control.Category.Reader
29+import Control.Category.Structures
30+import Control.Lens.SemiIso
31+import Control.SIArrow
32+import Data.Bits
33+import Data.Char
34+import Data.MonoTraversable
35+import Data.Scientific (Scientific)
36+import Data.Syntax
37+import Data.Syntax.Combinator
38+import Data.Text (Text)
39+
40+-- | Syntax constrainted to sequences of chars.
41+--
42+-- 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.
44+class (Syntax syn, Element (Seq syn) ~ Char) => SyntaxChar syn where
45+ -- | An unsigned decimal number.
46+ decimal :: Integral a => syn () a
47+
48+ -- | An unsigned hexadecimal number.
49+ hexadecimal :: (Integral a, Bits a) => syn () a
50+
51+ -- | A signed real number.
52+ realFloat :: RealFloat a => syn () a
53+
54+ -- | A scientific number.
55+ scientific :: syn () Scientific
56+
57+ {-# MINIMAL decimal, hexadecimal, realFloat, scientific #-}
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+
65+-- | An useful synonym for SyntaxChars with Text sequences.
66+type SyntaxText syn = (SyntaxChar syn, Seq syn ~ Text)
67+
68+-- | A number with an optional leading '+' or '-' sign character.
69+signed :: (Real a, SyntaxChar syn) => syn () a -> syn () a
70+signed n = _Negative /$/ char '-' */ n
71+ /+/ opt_ (char '+') */ n
72+
73+-- | Accepts zero or more spaces. Generates a single space.
74+spaces :: SyntaxChar syn => syn () ()
75+spaces = opt spaces1
76+
77+-- | Accepts zero or more spaces. Generates no output.
78+spaces_ :: SyntaxChar syn => syn () ()
79+spaces_ = opt_ spaces1
80+
81+-- | Accepts one or more spaces. Generates a single space.
82+spaces1 :: SyntaxChar syn => syn () ()
83+spaces1 = constant (opoint ' ') /$/ takeWhile1 isSpace
84+
85+-- | Accepts a single newline. Generates a newline.
86+endOfLine :: SyntaxChar syn => syn () ()
87+endOfLine = char '\n'
88+
89+-- | A decimal digit.
90+digitDec :: SyntaxChar syn => syn () Int
91+digitDec = semiIso toChar toInt /$/ anyChar
92+ where toInt c | isDigit c = Right (digitToInt c)
93+ | otherwise = Left ("Expected a decimal digit, got " ++ [c])
94+ toChar i | i >= 0 && i <= 9 = Right (intToDigit i)
95+ | otherwise = Left ("Expected a decimal digit, got number " ++ show i)
96+
97+-- | An octal digit.
98+digitOct :: SyntaxChar syn => syn () Int
99+digitOct = semiIso toChar toInt /$/ anyChar
100+ where toInt c | isOctDigit c = Right (digitToInt c)
101+ | otherwise = Left ("Expected an octal digit, got " ++ [c])
102+ toChar i | i >= 0 && i <= 7 = Right (intToDigit i)
103+ | otherwise = Left ("Expected an octal digit, got number " ++ show i)
104+
105+-- | A hex digit.
106+digitHex :: SyntaxChar syn => syn () Int
107+digitHex = semiIso toChar toInt /$/ anyChar
108+ where toInt c | isHexDigit c = Right (digitToInt c)
109+ | otherwise = Left ("Expected a hex digit, got " ++ [c])
110+ toChar i | i >= 0 && i <= 15 = Right (intToDigit i)
111+ | otherwise = Left ("Expected a hex digit, got number " ++ show i)
Data/Syntax/Combinator.hsnew file+190
@@ -0,0 +1,190 @@
1+{-# LANGUAGE RankNTypes #-}
2+{-# LANGUAGE ScopedTypeVariables #-}
3+{-# LANGUAGE FlexibleContexts #-}
4+{- |
5+Module : Data.Syntax.Combinator
6+Description : Combinators that work with any sequence type.
7+Copyright : (c) Daan Leijen 1999-2001, Bryan O'Sullivan 2007-2014, Paweł Nowak 2014
8+License : MIT
9+
10+Maintainer : Paweł Nowak <pawel834@gmail.com>
11+Stability : experimental
12+
13+Combinators that work with any sequence type.
14+-}
15+module Data.Syntax.Combinator
16+ (
17+ -- * Combinators.
18+ optional,
19+ opt,
20+ opt_,
21+ choice,
22+ eitherOf,
23+
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
52+import Control.Lens.SemiIso
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)
59+
60+-- | One or zero occurences of @f@.
61+optional :: SIArrow cat => cat () a -> cat () (Maybe a)
62+optional f = _Just /$/ f /+/ sipure _Nothing
63+
64+-- | Like 'optional', but specialized for @()@.
65+opt :: SIArrow cat => cat () () -> cat () ()
66+opt f = f /+/ sipure id
67+
68+-- | Parser one or zero occurences of @f@, but prints nothing.
69+opt_ :: SIArrow cat => cat () () -> cat () ()
70+opt_ f = semiIso (const (Left "opt_")) Right /$/ f
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
81+
82+-- | @manyTill p end@ applies action p zero or more times until action
83+-- end succeeds, and returns the list of values returned by p.
84+manyTill :: SIArrow cat => cat () a -> cat () () -> cat () [a]
85+manyTill p end = _Empty /$/ end
86+ /+/ _Cons /$/ p /*/ manyTill p end
87+
88+-- | Zero or more occurences of @v@ separated by @s@.
89+sepBy :: SIArrow cat => cat () a -> cat () () -> cat () [a]
90+sepBy v s = sepBy1 v s /+/ sipure _Empty
91+
92+-- | One or more occurences of @v@ separated by @s@.
93+sepBy1 :: SIArrow cat => cat () a -> cat () () -> cat () [a]
94+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+
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.hsnew file+73
@@ -0,0 +1,73 @@
1+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
2+{-# LANGUAGE FlexibleInstances #-}
3+{-# LANGUAGE TypeFamilies #-}
4+{- |
5+Module : Data.Syntax.Indent
6+Description : Simple indentation.
7+Copyright : (c) Paweł Nowak
8+License : MIT
9+
10+Maintainer : Paweł Nowak <pawel834@gmail.com>
11+Stability : experimental
12+
13+Provides a very simple indentation as a category transformer.
14+-}
15+module Data.Syntax.Indent (
16+ Indent,
17+ runIndent,
18+ breakLine,
19+ indented
20+ ) where
21+
22+import Control.Category
23+import Control.Category.Reader
24+import Control.Category.Structures
25+import Control.SIArrow
26+import Data.Syntax
27+import Data.Syntax.Char
28+import Data.Syntax.Combinator
29+import Prelude hiding (takeWhile, take, id, (.))
30+
31+-- | Adds indentation to a syntax description.
32+newtype Indent cat a b = Indent { getIndent :: ReaderCT (Int, cat () ()) cat a b }
33+ deriving (Category, Products, Coproducts, CatPlus, SIArrow)
34+
35+instance CatTrans Indent where
36+ clift = Indent . clift
37+
38+-- Generalized newtype deriving cannot derive this :(
39+
40+instance Syntax syn => Syntax (Indent syn) where
41+ type Seq (Indent syn) = Seq syn
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
53+
54+instance SyntaxChar syn => SyntaxChar (Indent syn) where
55+ decimal = Indent decimal
56+ hexadecimal = Indent hexadecimal
57+ scientific = Indent scientific
58+ realFloat = Indent realFloat
59+
60+-- | @runIndent m tab@ runs the 'Indent' transformer using @tab@ once for each
61+-- level of indentation.
62+runIndent :: Indent cat a b -> cat () () -> cat a b
63+runIndent (Indent m) tab = runReaderCT m (0, tab)
64+
65+-- | Inserts a new line and correct indentation, but does not
66+-- require any formatting when parsing (it just skips all white space).
67+breakLine :: SyntaxChar syn => Indent syn () ()
68+breakLine = Indent . ReaderCT $ \(i, tab) ->
69+ opt (char '\n') /* opt (sireplicate_ i tab) /* spaces_
70+
71+-- | Increases the indentation level of its argument by one.
72+indented :: Indent cat a b -> Indent cat a b
73+indented (Indent f) = Indent . ReaderCT $ \(i, tab) -> runReaderCT f (i + 1, tab)
Test.hsdeleted−263
@@ -1,263 +0,0 @@
1−{-# LANGUAGE TypeFamilies #-}
2−{-# LANGUAGE TupleSections #-}
3−{-# LANGUAGE FlexibleContexts #-}
4−{-# LANGUAGE FlexibleInstances #-}
5−{-# LANGUAGE DefaultSignatures #-}
6−{-# LANGUAGE OverloadedStrings #-}
7−{-# LANGUAGE MultiParamTypeClasses #-}
8−{-# LANGUAGE FunctionalDependencies #-}
9−module Test where
10−
11−import Prelude hiding (id, (.), take, takeWhile)
12−
13−import Control.Applicative
14−import Control.Arrow
15−import Control.Category
16−import Control.Lens hiding (imap, _Cons)
17−import Control.Monad
18−import qualified Data.Attoparsec.Text as Text
19−import Data.Attoparsec.Types
20−import Data.Char
21−import Data.Functor.Identity
22−import Data.MonoTraversable
23−import Data.Sequences hiding (take, takeWhile)
24−import Data.Text (Text)
25−
26−infixl 3 /|/
27−infixl 4 /$/
28−infixl 5 /*/, /*, */
29−
30−-- | Isomorphism in the kleisli category of some monad.
31−data KleisliIso m a b = KleisliIso (Kleisli m a b) (Kleisli m b a)
32−
33−instance Monad m => Category (KleisliIso m) where
34− id = KleisliIso id id
35− (KleisliIso f g) . (KleisliIso f' g') = KleisliIso (f . f') (g' . g)
36−
37−isoK :: (a -> m b) -> (b -> m a) -> KleisliIso m a b
38−isoK f g = KleisliIso (Kleisli f) (Kleisli g)
39−
40−apply :: KleisliIso m a b -> a -> m b
41−apply (KleisliIso (Kleisli f) _) = f
42−
43−unapply :: KleisliIso m a b -> b -> m a
44−unapply (KleisliIso _ (Kleisli g)) = g
45−
46−from :: KleisliIso m a b -> KleisliIso m b a
47−from (KleisliIso f g) = KleisliIso g f
48−
49−unit :: Monad m => KleisliIso m (a, ()) a
50−unit = isoK (return . fst) (return . (, ()))
51−
52−symmetry :: Monad m => KleisliIso m (a, b) (b, a)
53−symmetry = isoK f f
54− where f (a, b) = return (b, a)
55−
56−equalTo :: (Eq a, Monad m) => a -> KleisliIso m a ()
57−equalTo x = isoK f g
58− where
59− f y | x == y = return ()
60− | otherwise = fail "equalTo: not equal"
61− g _ = return x
62−
63−oneWayConst :: Monad m => a -> KleisliIso m a ()
64−oneWayConst x = isoK f g
65− where
66− f _ = return ()
67− g _ = return x
68−
69−check :: Monad m => (a -> Bool) -> KleisliIso m a a
70−check p = isoK f f
71− where f x | p x = return x
72− | otherwise = fail "check: predicate failed"
73−
74−packed :: (Monad m, IsSequence seq) => KleisliIso m [Element seq] seq
75−packed = isoK (return . fromList) (return . otoList)
76−
77−-- | Isomorphism between unit and empty list.
78−_Nil :: Monad m => KleisliIso m () [a]
79−_Nil = isoK f g
80− where
81− f _ = return []
82− g [] = return ()
83− g _ = fail "expected empty list"
84−
85−-- | Isomorphism between (head, tail) and a non empty list.
86−_Cons :: Monad m => KleisliIso m (a, [a]) [a]
87−_Cons = isoK f g
88− where
89− f (x, xs) = return (x:xs)
90− g (x:xs) = return (x, xs)
91− g _ = fail "expected non-empty list"
92−
93−-- | A functor from the category of isomorphisms of the Kleisli category
94−-- of some monad to Hask.
95−class IsoFunctor f where
96− imap :: KleisliIso Identity a b -> f a -> f b
97− imapK :: KleisliIso m a b -> f a -> f (m b)
98−
99−(/$/) :: IsoFunctor f => KleisliIso Identity a b -> f a -> f b
100−(/$/) = imap
101−
102−class IsoFunctor f => IsoPointed f where
103− iunit :: f ()
104− iunit = ipure id
105−
106− ipure :: KleisliIso Identity () a -> f a
107− ipure = (/$/ iunit)
108−
109− ipureK :: KleisliIso m () a -> f (m a)
110− ipureK = (`imapK` iunit)
111−
112− {-# MINIMAL iunit | ipure #-}
113−
114−class IsoFunctor f => IsoFail f where
115− ifail :: String -> f a
116−
117−class IsoPointed f => IsoApply f where
118− (/*/) :: f a -> f b -> f (a, b)
119−
120− (/*) :: f a -> f () -> f a
121− f /* g = unit /$/ f /*/ g
122−
123− (*/) :: f () -> f b -> f b
124− f */ g = unit . symmetry /$/ f /*/ g
125−
126− {-# MINIMAL (/*/) #-}
127−
128−class IsoApply f => IsoAlternative f where
129− iempty :: f a
130− (/|/) :: f a -> f a -> f a
131−
132− isome :: f a -> f [a]
133− isome v = _Cons /$/ v /*/ imany v
134−
135− imany :: f a -> f [a]
136− imany v = isome v /|/ ipure _Nil
137−
138− sepBy :: f a -> f () -> f [a]
139− sepBy v s = sepBy1 v s /|/ ipure _Nil
140−
141− sepBy1 :: f a -> f () -> f [a]
142− sepBy1 v s = _Cons /$/ v /* s /*/ sepBy v s
143−
144− {-# MINIMAL iempty, (/|/) #-}
145−
146−class (IsoAlternative syn, IsoFail syn) => Syntax syn seq | syn -> seq where
147− joinErr :: syn (Either String a) -> syn a
148−
149− anyChar :: syn (Element seq)
150−
151− char :: Element seq -> syn ()
152− default char :: Eq (Element seq) => Element seq -> syn ()
153− char c = equalTo c /$/ anyChar
154−
155− satisfy :: (Element seq -> Bool) -> syn (Element seq)
156− satisfy p = joinErr (imapK (check p) anyChar)
157−
158− string :: seq -> syn ()
159− default string :: (IsSequence seq, Eq seq) => seq -> syn ()
160− string s = equalTo s /$/ take (olength s)
161−
162− take :: Int -> syn seq
163− default take :: IsSequence seq => Int -> syn seq
164− take n = packed /$/ ireplicate n anyChar
165−
166− takeWhile :: (Element seq -> Bool) -> syn seq
167− default takeWhile :: IsSequence seq => (Element seq -> Bool) -> syn seq
168− takeWhile p = packed /$/ imany (satisfy p)
169−
170− takeWhile1 :: (Element seq -> Bool) -> syn seq
171− default takeWhile1 :: IsSequence seq => (Element seq -> Bool) -> syn seq
172− takeWhile1 p = packed /$/ isome (satisfy p)
173−
174− {-# MINIMAL joinErr, anyChar #-}
175−
176−ireplicate :: IsoApply f => Int -> f a -> f [a]
177−ireplicate 0 _ = ipure _Nil
178−ireplicate n m = _Cons /$/ m /*/ ireplicate (n-1) m
179−
180−isequence :: IsoApply f => [f a] -> f [a]
181−isequence [] = ipure _Nil
182−isequence (x:xs) = _Cons /$/ x /*/ isequence xs
183−
184−skipSpace :: (Syntax syn seq, IsSequence seq, Element seq ~ Char) => syn ()
185−skipSpace = oneWayConst (fromList []) /$/ takeWhile isSpace
186−
187−skipSpace1 :: (Syntax syn seq, IsSequence seq, Element seq ~ Char) => syn ()
188−skipSpace1 = oneWayConst (singleton ' ') /$/ takeWhile1 isSpace
189−
190−-- Attoparsec implementation.
191−
192−instance IsoFunctor (Parser i) where
193− imap i m = fmap (runIdentity . apply i) m
194− imapK i m = fmap (apply i) m
195−
196−instance IsoFail (Parser i) where
197− ifail = fail
198−
199−instance IsoPointed (Parser i) where
200− ipure = pure . runIdentity . (`apply` ())
201−
202−instance IsoApply (Parser i) where
203− f /*/ g = (,) <$> f <*> g
204−
205−instance IsoAlternative (Parser i) where
206− iempty = empty
207− (/|/) = (<|>)
208− imany = many
209− isome = some
210− sepBy = Text.sepBy
211− sepBy1 = Text.sepBy1
212−
213−instance Syntax (Parser Text) Text where
214− joinErr = (>>= either fail return)
215− anyChar = Text.anyChar
216− satisfy = Text.satisfy
217− char = void . Text.char
218− string = void . Text.string
219− takeWhile = Text.takeWhile
220− takeWhile1 = Text.takeWhile1
221−
222−-- Some AST.
223−
224−data AST = Var Text
225− | App AST AST
226− | Abs Text AST
227− deriving (Show)
228−
229−_Var :: Monad m => KleisliIso m Text AST
230−_Var = isoK f g
231− where
232− f = return . Var
233− g (Var t) = return t
234− g _ = fail "expected a Var"
235−
236−_App :: Monad m => KleisliIso m (AST, AST) AST
237−_App = isoK f g
238− where
239− f = return . uncurry App
240− g (App h x) = return (h, x)
241− g _ = fail "expected an App"
242−
243−_Abs :: Monad m => KleisliIso m (Text, AST) AST
244−_Abs = isoK f g
245− where
246− f = return . uncurry Abs
247− g (Abs n b) = return (n, b)
248− g _ = fail "expected an Abs"
249−
250−name :: Syntax syn Text => syn Text
251−name = takeWhile1 isAlphaNum
252−
253−atom :: Syntax syn Text => syn AST
254−atom = _Var /$/ name
255− /|/ char '(' */ expr /* char ')'
256−
257−expr :: Syntax syn Text => syn AST
258−expr = _App /$/ atom /* skipSpace1 /*/ atom
259− /|/ _Abs /$/ char '\\' /* skipSpace
260− */ name /* skipSpace
261− /* string "->" /* skipSpace
262− /*/ expr
263− /|/ atom
syntax.cabal+43−14
@@ -1,23 +1,52 @@
1−-- Initial syntax.cabal generated by cabal init. For further
2−-- documentation, see http://haskell.org/cabal/users-guide/
3−
4name: syntax
1name: syntax
5−version: 0.1.0.0
2+version: 1.0.0.0
6−synopsis: Abstract syntax descriptions for parsing and pretty-printing.
3+synopsis: Reversible parsing and pretty-printing.
7−-- description:
4+description:
5+ "syntax" allows you to write a single syntax description and instantiate is both as a parser and a pretty printer.
6+ .
7+ Syntax descriptions are written in applicative or arrow style. The library uses a custom typeclass hierarchy, provided
8+ by the "semi-iso" package. Most of the time you will be using operators like '/$/', '/*/' and '/+/' (= '<|>'), just
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.
11+ .
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.
14+ .
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)
19+ .
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.
24+ .
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 ;).
27+ .
28+ EXAMPLES! See @syntax-example@ and @syntax-example-json@ for examples.
29+ .
30+ * "syntax-example" implements a simple lambda calculus.
31+ .
32+ * "syntax-example-json" implements a json parser and pretty printer.
8license: MIT
33license: MIT
9license-file: LICENSE
34license-file: LICENSE
10author: Paweł Nowak
35author: Paweł Nowak
11maintainer: Paweł Nowak <pawel834@gmail.com>
36maintainer: Paweł Nowak <pawel834@gmail.com>
12−-- copyright:
37+copyright: Paweł Nowak 2014
13−-- category:
38+category: Data
14build-type: Simple
39build-type: Simple
15−-- extra-source-files:
16cabal-version: >=1.10
40cabal-version: >=1.10
17
41
42+source-repository head
43+ type: git
44+ location: git@github.com:Pawel834/syntax.git
45+
18library
46library
19− -- exposed-modules:
47+ exposed-modules: Data.Syntax
20− other-modules: Test
48+ Data.Syntax.Char
21− -- other-extensions:
49+ Data.Syntax.Combinator
50+ Data.Syntax.Indent
22− build-depends: base, transformers, attoparsec, text, mono-traversable, lens
51+ build-depends: base >= 4 && < 5, mono-traversable, lens >= 4, semi-iso >= 1, scientific >= 0.3, text, vector
23− default-language: Haskell2010
52+ default-language: Haskell2010