syntax 0.3.0.0 → 1.0.0.0
raw patch · 5 files changed
+365/−134 lines, 5 filesdep +vectordep ~semi-iso
Dependencies added: vector
Dependency ranges changed: semi-iso
Files
- Data/Syntax.hs +118/−30
- Data/Syntax/Char.hs +24/−17
- Data/Syntax/Combinator.hs +161/−23
- Data/Syntax/Indent.hs +39/−43
- syntax.cabal +23/−21
Data/Syntax.hs view
@@ -1,7 +1,6 @@+{-# LANGUAGE TypeFamilies #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE DefaultSignatures #-}-{-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE FunctionalDependencies #-} {- | Module : Data.Syntax Description : Abstract syntax description.@@ -11,22 +10,28 @@ Maintainer : Paweł Nowak <pawel834@gmail.com> Stability : experimental -Abstract syntax descriptions based on semi-isomorphisms.+Reversible parsing and pretty-printing. -} module Data.Syntax ( -- * Syntax. Syntax(..),+ Isolable(..), -- * Common isomorphisms. packed ) where -import Prelude hiding (take, takeWhile)+import Prelude hiding (take, takeWhile, id, (.)) -import Control.Lens.Iso-import Control.Lens.SemiIso-import Data.MonoTraversable-import Data.SemiIsoFunctor-import Data.Sequences hiding (take, takeWhile)+import Control.Category+import Control.Category.Reader+import Control.Category.Structures+import Control.Lens.Iso+import Control.Lens.SemiIso+import Control.SIArrow+import Data.MonoTraversable+import Data.Sequences hiding (take, takeWhile, replicate)+import qualified Data.Vector as V+import qualified Data.Vector.Unboxed as VU -- | An isomorphism between a sequence and a list of its elements. packed :: IsSequence seq => Iso' seq [Element seq]@@ -34,63 +39,146 @@ -- | An abstract syntax description based on semi-isomorphisms. ----- This class can be implemented by both parsers and printers (and maybe more?).--- +-- This class can be implemented by both parsers and printers.+-- -- The usual use is to write a polymorphic syntax description and instantiate it--- both as a parser and a printer. An example is available in the 'syntax-example'--- package.+-- both as a parser and a printer. Examples are available in 'syntax-example' and+-- 'syntax-example-json' packages. -- -- Methods of this class try to mimic "Data.Attoparsec.Text" interface.-class ( SemiIsoAlternative syn- , SemiIsoMonad syn- , IsSequence seq- , Eq seq- , Eq (Element seq)) - => Syntax syn seq | syn -> seq +class ( SIArrow syn+ , IsSequence (Seq syn)+ , Eq (Seq syn)+ , Eq (Element (Seq syn)))+ => Syntax syn where+ -- | The sequence type used by this syntax.+ type Seq syn :: * -- | Any character.- anyChar :: syn (Element seq)+ anyChar :: syn () (Element (Seq syn)) -- | A specific character.- char :: Element seq -> syn ()+ char :: Element (Seq syn) -> syn () () char c = rev (exact c) /$/ anyChar -- | Any character except the given one.- notChar :: Element seq -> syn (Element seq)+ notChar :: Element (Seq syn) -> syn () (Element (Seq syn)) notChar c = bifiltered (/= c) /$/ anyChar -- | Any character satisfying a predicate.- satisfy :: (Element seq -> Bool) -> syn (Element seq)+ satisfy :: (Element (Seq syn) -> Bool) -> syn () (Element (Seq syn)) satisfy p = bifiltered p /$/ anyChar -- | Transforms a character using a SemiIso and filters out values -- not satisfying the predicate.- satisfyWith :: ASemiIso' a (Element seq) -> (a -> Bool) -> syn a+ satisfyWith :: ASemiIso' a (Element (Seq syn)) -> (a -> Bool) -> syn () a satisfyWith ai p = bifiltered p . ai /$/ anyChar -- | A specific string.- string :: seq -> syn ()+ string :: Seq syn -> syn () () string s = rev (exact s) /$/ take (olength s) -- | A string of length @n@.- take :: Int -> syn seq+ take :: Int -> syn () (Seq syn) take n = packed /$/ sireplicate n anyChar -- | Maximal string which elements satisfy a predicate.- takeWhile :: (Element seq -> Bool) -> syn seq+ takeWhile :: (Element (Seq syn) -> Bool) -> syn () (Seq syn) takeWhile p = packed /$/ simany (satisfy p) -- | Maximal non-empty string which elements satisfy a predicate.- takeWhile1 :: (Element seq -> Bool) -> syn seq+ takeWhile1 :: (Element (Seq syn) -> Bool) -> syn () (Seq syn) takeWhile1 p = packed /$/ sisome (satisfy p) -- | Maximal string which elements do not satisfy a predicate.- takeTill :: (Element seq -> Bool) -> syn seq+ takeTill :: (Element (Seq syn) -> Bool) -> syn () (Seq syn) takeTill p = takeWhile (not . p) -- | Maximal non-empty string which elements do not satisfy a predicate.- takeTill1 :: (Element seq -> Bool) -> syn seq+ takeTill1 :: (Element (Seq syn) -> Bool) -> syn () (Seq syn) takeTill1 p = takeWhile1 (not . p) + -- | Constant size vector. The default implementation uses lists, but+ -- "syntax-attoparsec" and "syntax-printer" override it with an efficient+ -- implementation that works on a vector directly.+ --+ -- @vecN n e@ describes a size @n@ vector with elements @e@.+ --+ -- Also see 'Data.Syntax.Combinator.vec'.+ vecN :: Int -> syn () a -> syn () (V.Vector a)+ vecN n e = packed /$/ sireplicate n e++ -- | Constant size vector with index-aware element. The default implementation+ -- uses lists, but "syntax-attoparsec" and "syntax-printer" override it with an+ -- efficient implementation that works on a vector directly.+ --+ -- @ivecN n e@ describes a size @n@ vector with elements @e@. Each element+ -- gets its index and should output a value and the index unchanged.+ --+ -- Also see 'Data.Syntax.Combinator.ivec'.+ ivecN :: Int -> syn Int (Int, a) -> syn () (V.Vector a)+ ivecN n e = (packed /$/)+ $ sisequence+ $ map (\(i, e') -> constant i ^>> e'+ >>> first (sipure (constant i))+ >># unit . swapped)+ $ zip [0 .. n-1] (replicate n e)++ -- | Constant size unboxed vector. The default implementation uses lists, but+ -- "syntax-attoparsec" and "syntax-printer" override it with an efficient+ -- implementation that works on a vector directly.+ --+ -- @vecN n e@ describes a size @n@ vector with elements @e@.+ --+ -- Also see 'Data.Syntax.Combinator.vec'.+ uvecN :: VU.Unbox a => Int -> syn () a -> syn () (VU.Vector a)+ uvecN n e = packed /$/ sireplicate n e++ -- | Constant size unboxed vector with index-aware element. The default implementation+ -- uses lists, but "syntax-attoparsec" and "syntax-printer" override it with an+ -- efficient implementation that works on a vector directly.+ --+ -- @ivecN n e@ describes a size @n@ vector with elements @e@. Each element+ -- gets its index and should output a value and the index unchanged.+ --+ -- Also see 'Data.Syntax.Combinator.ivec'.+ uivecN :: VU.Unbox a => Int -> syn Int (Int, a) -> syn () (VU.Vector a)+ uivecN n e = (packed /$/)+ $ sisequence+ $ map (\(i, e') -> constant i ^>> e'+ >>> first (sipure (constant i))+ >># unit . swapped)+ $ zip [0 .. n-1] (replicate n e)+ {-# MINIMAL anyChar #-}++instance Syntax syn => Syntax (ReaderCT env syn) where+ type Seq (ReaderCT env syn) = Seq syn+ anyChar = clift anyChar+ char = clift . char+ notChar = clift . notChar+ satisfy = clift . satisfy+ satisfyWith ai = clift . satisfyWith ai+ string = clift . string+ take = clift . take+ takeWhile = clift . takeWhile+ takeWhile1 = clift . takeWhile1+ takeTill = clift . takeTill+ takeTill1 = clift . takeTill1++-- | Execute a computation in an isolated context.+--+-- The motivating example: you want to write a function+--+-- > serializeList :: Syntax syn => syn () a -> syn () [a]+--+-- Notice that we cannot just use simany, because the first @syn () a@+-- could eat the entire sequence (even though we printed more than 1 value!), so+-- we have to insert some kind of separators between the element. But how can we+-- be sure that @syn () a@ will not eat our separators? We can't! Thats why we+-- have to do the parsing in two stages: first extract the sequence between separators,+-- then run the @syn () a@ on this sequence.+class Syntax syn => Isolable syn where+ -- | Turns a computation into one executed in an isolated context.+ isolate :: syn () b -> syn (Seq syn) b
Data/Syntax/Char.hs view
@@ -1,6 +1,5 @@ {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE ConstraintKinds #-}-{-# LANGUAGE MultiParamTypeClasses #-} {- | Module : Data.Syntax.Char Description : Char specific combinators.@@ -26,12 +25,14 @@ digitHex ) where +import Control.Category.Reader+import Control.Category.Structures import Control.Lens.SemiIso+import Control.SIArrow import Data.Bits import Data.Char import Data.MonoTraversable import Data.Scientific (Scientific)-import Data.SemiIsoFunctor import Data.Syntax import Data.Syntax.Combinator import Data.Text (Text)@@ -40,47 +41,53 @@ -- -- Note: methods of this class do not have default implementations (for now), -- because their code is quite ugly and already written in most parser libraries.-class (Syntax syn seq, Element seq ~ Char) => SyntaxChar syn seq where+class (Syntax syn, Element (Seq syn) ~ Char) => SyntaxChar syn where -- | An unsigned decimal number.- decimal :: Integral a => syn a+ decimal :: Integral a => syn () a -- | An unsigned hexadecimal number.- hexadecimal :: (Integral a, Bits a) => syn a+ hexadecimal :: (Integral a, Bits a) => syn () a -- | A signed real number.- realFloat :: RealFloat a => syn a+ realFloat :: RealFloat a => syn () a -- | A scientific number.- scientific :: syn Scientific+ scientific :: syn () Scientific {-# MINIMAL decimal, hexadecimal, realFloat, scientific #-} +instance SyntaxChar syn => SyntaxChar (ReaderCT env syn) where+ decimal = clift decimal+ hexadecimal = clift hexadecimal+ scientific = clift scientific+ realFloat = clift realFloat+ -- | An useful synonym for SyntaxChars with Text sequences.-type SyntaxText syn = SyntaxChar syn Text+type SyntaxText syn = (SyntaxChar syn, Seq syn ~ Text) -- | A number with an optional leading '+' or '-' sign character.-signed :: (Real a, SyntaxChar syn seq) => syn a -> syn a+signed :: (Real a, SyntaxChar syn) => syn () a -> syn () a signed n = _Negative /$/ char '-' */ n- /|/ opt_ (char '+') */ n+ /+/ opt_ (char '+') */ n -- | Accepts zero or more spaces. Generates a single space.-spaces :: SyntaxChar syn seq => syn ()+spaces :: SyntaxChar syn => syn () () spaces = opt spaces1 -- | Accepts zero or more spaces. Generates no output.-spaces_ :: SyntaxChar syn seq => syn ()+spaces_ :: SyntaxChar syn => syn () () spaces_ = opt_ spaces1 -- | Accepts one or more spaces. Generates a single space.-spaces1 :: SyntaxChar syn seq => syn ()+spaces1 :: SyntaxChar syn => syn () () spaces1 = constant (opoint ' ') /$/ takeWhile1 isSpace -- | Accepts a single newline. Generates a newline.-endOfLine :: SyntaxChar syn seq => syn ()+endOfLine :: SyntaxChar syn => syn () () endOfLine = char '\n' -- | A decimal digit.-digitDec :: SyntaxChar syn seq => syn Int+digitDec :: SyntaxChar syn => syn () Int digitDec = semiIso toChar toInt /$/ anyChar where toInt c | isDigit c = Right (digitToInt c) | otherwise = Left ("Expected a decimal digit, got " ++ [c])@@ -88,7 +95,7 @@ | otherwise = Left ("Expected a decimal digit, got number " ++ show i) -- | An octal digit.-digitOct :: SyntaxChar syn seq => syn Int+digitOct :: SyntaxChar syn => syn () Int digitOct = semiIso toChar toInt /$/ anyChar where toInt c | isOctDigit c = Right (digitToInt c) | otherwise = Left ("Expected an octal digit, got " ++ [c])@@ -96,7 +103,7 @@ | otherwise = Left ("Expected an octal digit, got number " ++ show i) -- | A hex digit.-digitHex :: SyntaxChar syn seq => syn Int+digitHex :: SyntaxChar syn => syn () Int digitHex = semiIso toChar toInt /$/ anyChar where toInt c | isHexDigit c = Right (digitToInt c) | otherwise = Left ("Expected a hex digit, got " ++ [c])
Data/Syntax/Combinator.hs view
@@ -1,3 +1,6 @@+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE FlexibleContexts #-} {- | Module : Data.Syntax.Combinator Description : Combinators that work with any sequence type.@@ -9,44 +12,179 @@ Combinators that work with any sequence type. -}-module Data.Syntax.Combinator where+module Data.Syntax.Combinator+ (+ -- * Combinators.+ optional,+ opt,+ opt_,+ choice,+ eitherOf, -import Control.Lens-import Control.Lens.SemiIso-import Data.SemiIsoFunctor+ -- * Lists.+ manyTill,+ sepBy,+ sepBy1, + -- * Arrowized combinators.+ takeArr,++ -- * Vectors.+ vecNSepBy,+ ivecNSepBy,+ vec,+ vecSepBy,+ ivec,+ ivecSepBy,++ -- * Unboxed vectors.+ uvecNSepBy,+ uivecNSepBy,+ uvec,+ uvecSepBy,+ uivec,+ uivecSepBy+ ) where++import Control.Category+import Control.Category.Structures+import Control.Lens+import Control.Lens.SemiIso+import Control.SIArrow+import qualified Data.MonoTraversable as Seq+import Data.Syntax+import qualified Data.Vector as V+import qualified Data.Vector.Unboxed as VU+import Prelude hiding (id, (.), take)+ -- | One or zero occurences of @f@.-optional :: SemiIsoAlternative f => f a -> f (Maybe a)-optional f = _Just /$/ f /|/ sipure _Nothing+optional :: SIArrow cat => cat () a -> cat () (Maybe a)+optional f = _Just /$/ f /+/ sipure _Nothing -- | Like 'optional', but specialized for @()@.-opt :: SemiIsoAlternative f => f () -> f ()-opt f = f /|/ sipure id+opt :: SIArrow cat => cat () () -> cat () ()+opt f = f /+/ sipure id -- | Parser one or zero occurences of @f@, but prints nothing.-opt_ :: SemiIsoAlternative f => f () -> f ()+opt_ :: SIArrow cat => cat () () -> cat () () opt_ f = semiIso (const (Left "opt_")) Right /$/ f- /|/ sipure id+ /+/ sipure id +-- | Tries to apply the actions in the list in order, until one of+-- them succeeds. Returns the value of the succeeding action.+choice :: SIArrow cat => [cat () a] -> cat () a+choice = foldr (/+/) (sifail "choice: all alternatives failed")++-- | Combine two alternatives.+eitherOf :: SIArrow cat => cat () a -> cat () b -> cat () (Either a b)+eitherOf a b = _Left /$/ a /+/ _Right /$/ b+ -- | @manyTill p end@ applies action p zero or more times until action -- end succeeds, and returns the list of values returned by p.-manyTill :: SemiIsoAlternative f => f a -> f () -> f [a]+manyTill :: SIArrow cat => cat () a -> cat () () -> cat () [a] manyTill p end = _Empty /$/ end- /|/ _Cons /$/ p /*/ manyTill p end+ /+/ _Cons /$/ p /*/ manyTill p end -- | Zero or more occurences of @v@ separated by @s@.-sepBy :: SemiIsoAlternative f => f a -> f () -> f [a]-sepBy v s = sepBy1 v s /|/ sipure _Empty+sepBy :: SIArrow cat => cat () a -> cat () () -> cat () [a]+sepBy v s = sepBy1 v s /+/ sipure _Empty -- | One or more occurences of @v@ separated by @s@.-sepBy1 :: SemiIsoAlternative f => f a -> f () -> f [a]-sepBy1 v s = _Cons /$/ v /*/ (s */ sepBy1 v s /|/ sipure _Empty)+sepBy1 :: SIArrow cat => cat () a -> cat () () -> cat () [a]+sepBy1 v s = _Cons /$/ v /*/ (s */ sepBy1 v s /+/ sipure _Empty) --- | Tries to apply the actions in the list in order, until one of--- them succeeds. Returns the value of the succeeding action.-choice :: SemiIsoAlternative f => [f a] -> f a-choice = foldr (/|/) (sifail "choice: all alternatives failed")+-- | A string of given length.+takeArr :: Syntax syn => syn Int (Seq syn)+takeArr = sibind $ iso (\n -> constant n #>> take n)+ (\s -> constant (Seq.olength s) #>> take (Seq.olength s)) --- | Combine two alternatives.-eitherOf :: SemiIsoAlternative f => f a -> f b -> f (Either a b)-eitherOf a b = _Left /$/ a /|/ _Right /$/ b+-- | Constant size vector with separators.+--+-- @vecNSepBy n e sep@ describes a size @n@ vector with elements @e@ separated by @sep@.+vecNSepBy :: Syntax syn => Int -> syn () a -> syn () () -> syn () (V.Vector a)+vecNSepBy n e sep = ivecNSepBy n (unit ^>> second e) sep++-- | Constant size vector with separators and index-aware elements.+--+-- @ivecNSepBy n e sep@ describes a size @n@ vector with elements @e@ separated by @sep@.+-- Each element gets its index and should output a value and the index unchanged.+ivecNSepBy :: Syntax syn => Int -> syn Int (Int, a) -> syn () () -> syn () (V.Vector a)+ivecNSepBy n e sep = ivecN n $ sibind $ iso el (el . fst)+ where+ el k | k < n - 1 = unit ^>> e *** sep >># unit+ | otherwise = e++-- | Runtime sized vector. The size can depend on the result of some computation.+--+-- @vec e@ describes a vector with elements @e@.+vec :: Syntax syn => syn () a -> syn Int (V.Vector a)+vec e = vecSepBy e (siarr id)++-- | Runtime sized vector with separators. The size can depend on the result of some+-- computation.+--+-- @vecSepBy e sep@ describes a vector with elements @e@ separated by @sep@.+vecSepBy :: Syntax syn => syn () a -> syn () () -> syn Int (V.Vector a)+vecSepBy e sep = ivecSepBy (unit ^>> second e) sep++-- | Runtime sized vector with index-aware elements. The size can depend on the result+-- of some computation.+--+-- @ivec e@ describes a vector with elements @e@.+ivec :: Syntax syn => syn Int (Int, a) -> syn Int (V.Vector a)+ivec e = ivecSepBy e (siarr id)++-- | Runtime sized vector with index-aware elements and separators. The size can depend+-- on the result of some computation.+--+-- @ivecSepBy e sep@ describes a vector with elements @e@ separated by @sep@.+ivecSepBy :: Syntax syn => syn Int (Int, a) -> syn () () -> syn Int (V.Vector a)+ivecSepBy e sep = sibind $ iso (\n -> constant n #>> ivecNSepBy n e sep)+ (\v -> constant (V.length v) #>> ivecNSepBy (V.length v) e sep)++-- | Constant size unboxed vector with separators.+--+-- @uvecNSepBy n e sep@ describes a size @n@ vector with elements @e@ separated by @sep@.+uvecNSepBy :: (Syntax syn, VU.Unbox a) => Int -> syn () a -> syn () () -> syn () (VU.Vector a)+uvecNSepBy n e sep = uivecNSepBy n (unit ^>> second e) sep++-- | Constant size unboxed vector with separators and index-aware elements.+--+-- @uivecNSepBy n e sep@ describes a size @n@ vector with elements @e@ separated by @sep@.+-- Each element gets its index and should output a value and the index unchanged.+uivecNSepBy :: (Syntax syn, VU.Unbox a) => Int -> syn Int (Int, a)+ -> syn () () -> syn () (VU.Vector a)+uivecNSepBy n e sep = uivecN n $ sibind $ iso el (el . fst)+ where+ el k | k < n - 1 = unit ^>> e *** sep >># unit+ | otherwise = e++-- | Runtime sized unboxed vector. The size can depend on the result of some computation.+--+-- @uvec e@ describes a vector with elements @e@.+uvec :: (Syntax syn, VU.Unbox a) => syn () a -> syn Int (VU.Vector a)+uvec e = uvecSepBy e (siarr id)++-- | Runtime sized unboxed vector with separators. The size can depend on the result of some+-- computation.+--+-- @uvecSepBy e sep@ describes a vector with elements @e@ separated by @sep@.+uvecSepBy :: (Syntax syn, VU.Unbox a) => syn () a -> syn () () -> syn Int (VU.Vector a)+uvecSepBy e sep = uivecSepBy (unit ^>> second e) sep++-- | Runtime sized unboxed vector with index-aware elements. The size can depend on the result+-- of some computation.+--+-- @uivec e@ describes a vector with elements @e@.+uivec :: (Syntax syn, VU.Unbox a) => syn Int (Int, a) -> syn Int (VU.Vector a)+uivec e = uivecSepBy e (siarr id)++-- | Runtime sized unboxed vector with index-aware elements and separators. The size can depend+-- on the result of some computation.+--+-- @uivecSepBy e sep@ describes a vector with elements @e@ separated by @sep@.+uivecSepBy :: (Syntax syn, VU.Unbox a) => syn Int (Int, a)+ -> syn () () -> syn Int (VU.Vector a)+uivecSepBy e sep = sibind $ iso (\n -> constant n #>> uivecNSepBy n e sep)+ (\v -> constant (VU.length v)+ #>> uivecNSepBy (VU.length v) e sep)
Data/Syntax/Indent.hs view
@@ -1,16 +1,16 @@+{-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE UndecidableInstances #-}-{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE TypeFamilies #-} {- | Module : Data.Syntax.Indent-Description : Indentation.+Description : Simple indentation. Copyright : (c) Paweł Nowak License : MIT Maintainer : Paweł Nowak <pawel834@gmail.com> Stability : experimental -Provides a very simple indentation as a \"monad\" transformer.+Provides a very simple indentation as a category transformer. -} module Data.Syntax.Indent ( Indent,@@ -19,59 +19,55 @@ indented ) where -import Data.SemiIsoFunctor+import Control.Category+import Control.Category.Reader+import Control.Category.Structures+import Control.SIArrow import Data.Syntax import Data.Syntax.Char import Data.Syntax.Combinator-import Prelude hiding (takeWhile, take)+import Prelude hiding (takeWhile, take, id, (.)) -- | Adds indentation to a syntax description.-newtype Indent m a = Indent { unIndent :: (Int, m ()) -> m a }--instance SemiIsoFunctor m => SemiIsoFunctor (Indent m) where- simap f (Indent g) = Indent $ \i -> simap f (g i)--instance SemiIsoApply m => SemiIsoApply (Indent m) where- sipure ai = Indent $ \_ -> sipure ai- Indent f /*/ Indent g = Indent $ \i -> f i /*/ g i--instance SemiIsoAlternative m => SemiIsoAlternative (Indent m) where- siempty = Indent $ \_ -> siempty- Indent f /|/ Indent g = Indent $ \i -> f i /|/ g i+newtype Indent cat a b = Indent { getIndent :: ReaderCT (Int, cat () ()) cat a b }+ deriving (Category, Products, Coproducts, CatPlus, SIArrow) -instance SemiIsoMonad m => SemiIsoMonad (Indent m) where- (Indent m) //= f = Indent $ \i -> m i //= (\x -> unIndent (f x) i)+instance CatTrans Indent where+ clift = Indent . clift -instance SemiIsoFix m => SemiIsoFix (Indent m) where- sifix f = Indent $ \i -> sifix $ \y -> unIndent (f y) i+-- Generalized newtype deriving cannot derive this :( -instance Syntax syn seq => Syntax (Indent syn) seq where- anyChar = Indent $ const anyChar- char = Indent . const . char- notChar = Indent . const . notChar- satisfy = Indent . const . satisfy- satisfyWith ai = Indent . const . satisfyWith ai- string = Indent . const . string- take = Indent . const . take- takeWhile = Indent . const . takeWhile- takeWhile1 = Indent . const . takeWhile1- takeTill = Indent . const . takeTill- takeTill1 = Indent . const . takeTill1+instance Syntax syn => Syntax (Indent syn) where+ type Seq (Indent syn) = Seq syn+ anyChar = Indent anyChar+ char = Indent . char+ notChar = Indent . notChar+ satisfy = Indent . satisfy+ satisfyWith ai = Indent . satisfyWith ai+ string = Indent . string+ take = Indent . take+ takeWhile = Indent . takeWhile+ takeWhile1 = Indent . takeWhile1+ takeTill = Indent . takeTill+ takeTill1 = Indent . takeTill1 -instance SyntaxChar syn seq => SyntaxChar (Indent syn) seq where- decimal = Indent $ const decimal- scientific = Indent $ const scientific+instance SyntaxChar syn => SyntaxChar (Indent syn) where+ decimal = Indent decimal+ hexadecimal = Indent hexadecimal+ scientific = Indent scientific+ realFloat = Indent realFloat -- | @runIndent m tab@ runs the 'Indent' transformer using @tab@ once for each -- level of indentation.-runIndent :: Indent m a -> m () -> m a-runIndent = ($ 0) . curry . unIndent+runIndent :: Indent cat a b -> cat () () -> cat a b+runIndent (Indent m) tab = runReaderCT m (0, tab) -- | Inserts a new line and correct indentation, but does not -- require any formatting when parsing (it just skips all white space).-breakLine :: SyntaxChar syn seq => Indent syn ()-breakLine = Indent $ \(i, tab) -> opt (char '\n') /* opt (sireplicate_ i tab) /* spaces_+breakLine :: SyntaxChar syn => Indent syn () ()+breakLine = Indent . ReaderCT $ \(i, tab) -> + opt (char '\n') /* opt (sireplicate_ i tab) /* spaces_ -- | Increases the indentation level of its argument by one.-indented :: Indent m a -> Indent m a-indented (Indent f) = Indent $ \(i, tab) -> f (i + 1, tab)+indented :: Indent cat a b -> Indent cat a b+indented (Indent f) = Indent . ReaderCT $ \(i, tab) -> runReaderCT f (i + 1, tab)
syntax.cabal view
@@ -1,33 +1,35 @@ name: syntax-version: 0.3.0.0-synopsis: Syntax descriptions for unified parsing and pretty-printing.+version: 1.0.0.0+synopsis: Reversible parsing and pretty-printing. description:- 'syntax' allows you to write a single syntax description and instantiate is both as a parser and a pretty printer.- .- The interface is based on a custom Functor\/Applicative\/Monad hierarchy, provided by the 'semi-iso' package. You fmap using- a semi-isomorphism instead of function. A semi-isomorphism is a isomorphism that can fail in both directions, with slightly- weakened laws. It is worth to note that @Iso@s and @Prism@s from 'lens' are valid semi-isomorphisms :)- .- Once you write a description you can, for example turn it into an Attoparsec parser, or into a 'Data.Syntax.Printer.Text.Printer'.- .- See @syntax-example@ and @syntax-example-json@ for examples, @syntax-attoparsec@ and @syntax-printer@ for a parser/printer implementation.+ "syntax" allows you to write a single syntax description and instantiate is both as a parser and a pretty printer. .- The library was inspired by:+ Syntax descriptions are written in applicative or arrow style. The library uses a custom typeclass hierarchy, provided+ by the "semi-iso" package. Most of the time you will be using operators like '/$/', '/*/' and '/+/' (= '<|>'), just+ like parser combinators. When more power is needed - e.g. when the syntax depends on the parsed or printed value -+ you turn to arrows. .- * Rendel, Tillmann, and Klaus Ostermann. "Invertible syntax descriptions: unifying parsing and pretty printing." ACM Sigplan Notices. Vol. 45. No. 11. ACM, 2010.+ Semi-isomorphisms from "semi-iso" are the basic building block of syntax descriptions. I recommend reading+ the hackage page of "semi-iso" first, as it contains much more information. .- TODO:+ Once you write a syntax description (polymorphic in the syntax category) you can instantiate it both as a parser or as+ a pretty-printer. The library "syntax-attoparsec" gives you the ability to extract an Attoparsec parser. Pretty-printing+ is implemented by the "syntax-printer" library, which uses Text and ByteString builders. (Note that formatting is handled+ by "syntax" itself, not by the printer library) .- * Research relative monads and relative monad transformers. Indent is basically a Reader monad over a syntax. How would a State monad look?+ Advanced formatting and parsing (for example indentation, haskell layout rule) is implemented as category transformers+ (similar to monad transformers). Currently only simple indentation is implemented (in "Data.Syntax.Indent") - basically+ a reader category transformer that tracks current indentation level. I plan on implementing Haskell layout rule in the+ future. .- * Try to implement Haskell layout rule.+ The library can work with both text and binary data. Alas, there are no binary combinators implemented yet.+ I will implement them when i have the time (but these category transformers look so much more interesting for now ;). .- * Combinators for binary data formats, vectors.+ EXAMPLES! See @syntax-example@ and @syntax-example-json@ for examples. .- * Better error messages.+ * "syntax-example" implements a simple lambda calculus. .- * Maybe an implementation of do notation for SemiIsoMonad with QuasiQuoters, like the codo notation for comonads.-+ * "syntax-example-json" implements a json parser and pretty printer. license: MIT license-file: LICENSE author: Paweł Nowak@@ -46,5 +48,5 @@ Data.Syntax.Char Data.Syntax.Combinator Data.Syntax.Indent- build-depends: base >= 4 && < 5, mono-traversable, lens >= 4, semi-iso >= 0.5.0, scientific >= 0.3, text+ build-depends: base >= 4 && < 5, mono-traversable, lens >= 4, semi-iso >= 1, scientific >= 0.3, text, vector default-language: Haskell2010