diff --git a/Data/Syntax.hs b/Data/Syntax.hs --- a/Data/Syntax.hs +++ b/Data/Syntax.hs @@ -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 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 diff --git a/Data/Syntax/Char.hs b/Data/Syntax/Char.hs --- a/Data/Syntax/Char.hs +++ b/Data/Syntax/Char.hs @@ -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]) diff --git a/Data/Syntax/Combinator.hs b/Data/Syntax/Combinator.hs --- a/Data/Syntax/Combinator.hs +++ b/Data/Syntax/Combinator.hs @@ -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) diff --git a/Data/Syntax/Indent.hs b/Data/Syntax/Indent.hs --- a/Data/Syntax/Indent.hs +++ b/Data/Syntax/Indent.hs @@ -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 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) diff --git a/syntax.cabal b/syntax.cabal --- a/syntax.cabal +++ b/syntax.cabal @@ -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