git.iko.soy/syntax
on master help sign in
Generalize to arrows.
98259ccPaweł Nowak
Data/Syntax.hs+20−20
compare with master
unifiedsplit
@@ -1,7 +1,6 @@
1+{-# LANGUAGE TypeFamilies #-}
1{-# LANGUAGE FlexibleContexts #-}
2{-# LANGUAGE FlexibleContexts #-}
2{-# LANGUAGE DefaultSignatures #-}
3{-# LANGUAGE DefaultSignatures #-}
3−{-# LANGUAGE MultiParamTypeClasses #-}
4−{-# LANGUAGE FunctionalDependencies #-}
5{- |
4{- |
6Module : Data.Syntax
5Module : Data.Syntax
7Description : Abstract syntax description.
6Description : Abstract syntax description.
@@ -24,8 +23,8 @@ import Prelude hiding (take, takeWhile)
24
23
25import Control.Lens.Iso
24import Control.Lens.Iso
26import Control.Lens.SemiIso
25import Control.Lens.SemiIso
26+import Control.SIArrow
27import Data.MonoTraversable
27import Data.MonoTraversable
28−import Data.SemiIsoFunctor
29import Data.Sequences hiding (take, takeWhile)
28import Data.Sequences hiding (take, takeWhile)
30
29
31-- | An isomorphism between a sequence and a list of its elements.
30-- | An isomorphism between a sequence and a list of its elements.
@@ -41,56 +40,57 @@ packed = iso otoList fromList
41-- package.
40-- package.
42--
41--
43-- Methods of this class try to mimic "Data.Attoparsec.Text" interface.
42-- Methods of this class try to mimic "Data.Attoparsec.Text" interface.
44−class ( SemiIsoAlternative syn
43+class ( SIArrow syn
45− , SemiIsoMonad syn
46− , IsSequence seq
44+ , IsSequence (Seq syn)
47− , Eq seq
45+ , Eq (Seq syn)
48− , Eq (Element seq))
46+ , Eq (Element (Seq syn)))
49− => Syntax syn seq | syn -> seq
47+ => Syntax syn
50 where
48 where
49+ -- | The sequence type used by this syntax.
50+ type Seq syn :: *
51
51
52 -- | Any character.
52 -- | Any character.
53− anyChar :: syn (Element seq)
53+ anyChar :: syn () (Element (Seq syn))
54
54
55 -- | A specific character.
55 -- | A specific character.
56− char :: Element seq -> syn ()
56+ char :: Element (Seq syn) -> syn () ()
57 char c = rev (exact c) /$/ anyChar
57 char c = rev (exact c) /$/ anyChar
58
58
59 -- | Any character except the given one.
59 -- | Any character except the given one.
60− notChar :: Element seq -> syn (Element seq)
60+ notChar :: Element (Seq syn) -> syn () (Element (Seq syn))
61 notChar c = bifiltered (/= c) /$/ anyChar
61 notChar c = bifiltered (/= c) /$/ anyChar
62
62
63 -- | Any character satisfying a predicate.
63 -- | Any character satisfying a predicate.
64− satisfy :: (Element seq -> Bool) -> syn (Element seq)
64+ satisfy :: (Element (Seq syn) -> Bool) -> syn () (Element (Seq syn))
65 satisfy p = bifiltered p /$/ anyChar
65 satisfy p = bifiltered p /$/ anyChar
66
66
67 -- | Transforms a character using a SemiIso and filters out values
67 -- | Transforms a character using a SemiIso and filters out values
68 -- not satisfying the predicate.
68 -- not satisfying the predicate.
69− satisfyWith :: ASemiIso' a (Element seq) -> (a -> Bool) -> syn a
69+ satisfyWith :: ASemiIso' a (Element (Seq syn)) -> (a -> Bool) -> syn () a
70 satisfyWith ai p = bifiltered p . ai /$/ anyChar
70 satisfyWith ai p = bifiltered p . ai /$/ anyChar
71
71
72 -- | A specific string.
72 -- | A specific string.
73− string :: seq -> syn ()
73+ string :: (Seq syn) -> syn () ()
74 string s = rev (exact s) /$/ take (olength s)
74 string s = rev (exact s) /$/ take (olength s)
75
75
76 -- | A string of length @n@.
76 -- | A string of length @n@.
77− take :: Int -> syn seq
77+ take :: Int -> syn () (Seq syn)
78 take n = packed /$/ sireplicate n anyChar
78 take n = packed /$/ sireplicate n anyChar
79
79
80 -- | Maximal string which elements satisfy a predicate.
80 -- | Maximal string which elements satisfy a predicate.
81− takeWhile :: (Element seq -> Bool) -> syn seq
81+ takeWhile :: (Element (Seq syn) -> Bool) -> syn () (Seq syn)
82 takeWhile p = packed /$/ simany (satisfy p)
82 takeWhile p = packed /$/ simany (satisfy p)
83
83
84 -- | Maximal non-empty string which elements satisfy a predicate.
84 -- | Maximal non-empty string which elements satisfy a predicate.
85− takeWhile1 :: (Element seq -> Bool) -> syn seq
85+ takeWhile1 :: (Element (Seq syn) -> Bool) -> syn () (Seq syn)
86 takeWhile1 p = packed /$/ sisome (satisfy p)
86 takeWhile1 p = packed /$/ sisome (satisfy p)
87
87
88 -- | Maximal string which elements do not satisfy a predicate.
88 -- | Maximal string which elements do not satisfy a predicate.
89− takeTill :: (Element seq -> Bool) -> syn seq
89+ takeTill :: (Element (Seq syn) -> Bool) -> syn () (Seq syn)
90 takeTill p = takeWhile (not . p)
90 takeTill p = takeWhile (not . p)
91
91
92 -- | Maximal non-empty string which elements do not satisfy a predicate.
92 -- | Maximal non-empty string which elements do not satisfy a predicate.
93− takeTill1 :: (Element seq -> Bool) -> syn seq
93+ takeTill1 :: (Element (Seq syn) -> Bool) -> syn () (Seq syn)
94 takeTill1 p = takeWhile1 (not . p)
94 takeTill1 p = takeWhile1 (not . p)
95
95
96 {-# MINIMAL anyChar #-}
96 {-# MINIMAL anyChar #-}
Data/Syntax/Char.hs+16−17
@@ -1,6 +1,5 @@
1{-# LANGUAGE TypeFamilies #-}
1{-# LANGUAGE TypeFamilies #-}
2{-# LANGUAGE ConstraintKinds #-}
2{-# LANGUAGE ConstraintKinds #-}
3−{-# LANGUAGE MultiParamTypeClasses #-}
4{- |
3{- |
5Module : Data.Syntax.Char
4Module : Data.Syntax.Char
6Description : Char specific combinators.
5Description : Char specific combinators.
@@ -27,11 +26,11 @@ module Data.Syntax.Char (
27 ) where
26 ) where
28
27
29import Control.Lens.SemiIso
28import Control.Lens.SemiIso
29+import Control.SIArrow
30import Data.Bits
30import Data.Bits
31import Data.Char
31import Data.Char
32import Data.MonoTraversable
32import Data.MonoTraversable
33import Data.Scientific (Scientific)
33import Data.Scientific (Scientific)
34−import Data.SemiIsoFunctor
35import Data.Syntax
34import Data.Syntax
36import Data.Syntax.Combinator
35import Data.Syntax.Combinator
37import Data.Text (Text)
36import Data.Text (Text)
@@ -40,47 +39,47 @@ import Data.Text (Text)
40--
39--
41-- Note: methods of this class do not have default implementations (for now),
40-- Note: methods of this class do not have default implementations (for now),
42-- because their code is quite ugly and already written in most parser libraries.
41-- because their code is quite ugly and already written in most parser libraries.
43−class (Syntax syn seq, Element seq ~ Char) => SyntaxChar syn seq where
42+class (Syntax syn, Element (Seq syn) ~ Char) => SyntaxChar syn where
44 -- | An unsigned decimal number.
43 -- | An unsigned decimal number.
45− decimal :: Integral a => syn a
44+ decimal :: Integral a => syn () a
46
45
47 -- | An unsigned hexadecimal number.
46 -- | An unsigned hexadecimal number.
48− hexadecimal :: (Integral a, Bits a) => syn a
47+ hexadecimal :: (Integral a, Bits a) => syn () a
49
48
50 -- | A signed real number.
49 -- | A signed real number.
51− realFloat :: RealFloat a => syn a
50+ realFloat :: RealFloat a => syn () a
52
51
53 -- | A scientific number.
52 -- | A scientific number.
54− scientific :: syn Scientific
53+ scientific :: syn () Scientific
55
54
56 {-# MINIMAL decimal, hexadecimal, realFloat, scientific #-}
55 {-# MINIMAL decimal, hexadecimal, realFloat, scientific #-}
57
56
58-- | An useful synonym for SyntaxChars with Text sequences.
57-- | An useful synonym for SyntaxChars with Text sequences.
59−type SyntaxText syn = SyntaxChar syn Text
58+type SyntaxText syn = (SyntaxChar syn, Seq syn ~ Text)
60
59
61-- | A number with an optional leading '+' or '-' sign character.
60-- | A number with an optional leading '+' or '-' sign character.
62−signed :: (Real a, SyntaxChar syn seq) => syn a -> syn a
61+signed :: (Real a, SyntaxChar syn) => syn () a -> syn () a
63signed n = _Negative /$/ char '-' */ n
62signed n = _Negative /$/ char '-' */ n
64− /|/ opt_ (char '+') */ n
63+ /+/ opt_ (char '+') */ n
65
64
66-- | Accepts zero or more spaces. Generates a single space.
65-- | Accepts zero or more spaces. Generates a single space.
67−spaces :: SyntaxChar syn seq => syn ()
66+spaces :: SyntaxChar syn => syn () ()
68spaces = opt spaces1
67spaces = opt spaces1
69
68
70-- | Accepts zero or more spaces. Generates no output.
69-- | Accepts zero or more spaces. Generates no output.
71−spaces_ :: SyntaxChar syn seq => syn ()
70+spaces_ :: SyntaxChar syn => syn () ()
72spaces_ = opt_ spaces1
71spaces_ = opt_ spaces1
73
72
74-- | Accepts one or more spaces. Generates a single space.
73-- | Accepts one or more spaces. Generates a single space.
75−spaces1 :: SyntaxChar syn seq => syn ()
74+spaces1 :: SyntaxChar syn => syn () ()
76spaces1 = constant (opoint ' ') /$/ takeWhile1 isSpace
75spaces1 = constant (opoint ' ') /$/ takeWhile1 isSpace
77
76
78-- | Accepts a single newline. Generates a newline.
77-- | Accepts a single newline. Generates a newline.
79−endOfLine :: SyntaxChar syn seq => syn ()
78+endOfLine :: SyntaxChar syn => syn () ()
80endOfLine = char '\n'
79endOfLine = char '\n'
81
80
82-- | A decimal digit.
81-- | A decimal digit.
83−digitDec :: SyntaxChar syn seq => syn Int
82+digitDec :: SyntaxChar syn => syn () Int
84digitDec = semiIso toChar toInt /$/ anyChar
83digitDec = semiIso toChar toInt /$/ anyChar
85 where toInt c | isDigit c = Right (digitToInt c)
84 where toInt c | isDigit c = Right (digitToInt c)
86 | otherwise = Left ("Expected a decimal digit, got " ++ [c])
85 | otherwise = Left ("Expected a decimal digit, got " ++ [c])
@@ -88,7 +87,7 @@ digitDec = semiIso toChar toInt /$/ anyChar
88 | otherwise = Left ("Expected a decimal digit, got number " ++ show i)
87 | otherwise = Left ("Expected a decimal digit, got number " ++ show i)
89
88
90-- | An octal digit.
89-- | An octal digit.
91−digitOct :: SyntaxChar syn seq => syn Int
90+digitOct :: SyntaxChar syn => syn () Int
92digitOct = semiIso toChar toInt /$/ anyChar
91digitOct = semiIso toChar toInt /$/ anyChar
93 where toInt c | isOctDigit c = Right (digitToInt c)
92 where toInt c | isOctDigit c = Right (digitToInt c)
94 | otherwise = Left ("Expected an octal digit, got " ++ [c])
93 | otherwise = Left ("Expected an octal digit, got " ++ [c])
@@ -96,7 +95,7 @@ digitOct = semiIso toChar toInt /$/ anyChar
96 | otherwise = Left ("Expected an octal digit, got number " ++ show i)
95 | otherwise = Left ("Expected an octal digit, got number " ++ show i)
97
96
98-- | A hex digit.
97-- | A hex digit.
99−digitHex :: SyntaxChar syn seq => syn Int
98+digitHex :: SyntaxChar syn => syn () Int
100digitHex = semiIso toChar toInt /$/ anyChar
99digitHex = semiIso toChar toInt /$/ anyChar
101 where toInt c | isHexDigit c = Right (digitToInt c)
100 where toInt c | isHexDigit c = Right (digitToInt c)
102 | otherwise = Left ("Expected a hex digit, got " ++ [c])
101 | otherwise = Left ("Expected a hex digit, got " ++ [c])
Data/Syntax/Combinator.hs+17−17
@@ -13,40 +13,40 @@ module Data.Syntax.Combinator where
13
13
14import Control.Lens
14import Control.Lens
15import Control.Lens.SemiIso
15import Control.Lens.SemiIso
16−import Data.SemiIsoFunctor
16+import Control.SIArrow
17
17
18-- | One or zero occurences of @f@.
18-- | One or zero occurences of @f@.
19−optional :: SemiIsoAlternative f => f a -> f (Maybe a)
19+optional :: SIArrow cat => cat () a -> cat () (Maybe a)
20−optional f = _Just /$/ f /|/ sipure _Nothing
20+optional f = _Just /$/ f /+/ sipure _Nothing
21
21
22-- | Like 'optional', but specialized for @()@.
22-- | Like 'optional', but specialized for @()@.
23−opt :: SemiIsoAlternative f => f () -> f ()
23+opt :: SIArrow cat => cat () () -> cat () ()
24−opt f = f /|/ sipure id
24+opt f = f /+/ sipure id
25
25
26-- | Parser one or zero occurences of @f@, but prints nothing.
26-- | Parser one or zero occurences of @f@, but prints nothing.
27−opt_ :: SemiIsoAlternative f => f () -> f ()
27+opt_ :: SIArrow cat => cat () () -> cat () ()
28opt_ f = semiIso (const (Left "opt_")) Right /$/ f
28opt_ f = semiIso (const (Left "opt_")) Right /$/ f
29− /|/ sipure id
29+ /+/ sipure id
30
30
31-- | @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
32-- end succeeds, and returns the list of values returned by p.
32-- end succeeds, and returns the list of values returned by p.
33−manyTill :: SemiIsoAlternative f => f a -> f () -> f [a]
33+manyTill :: SIArrow cat => cat () a -> cat () () -> cat () [a]
34manyTill p end = _Empty /$/ end
34manyTill p end = _Empty /$/ end
35− /|/ _Cons /$/ p /*/ manyTill p end
35+ /+/ _Cons /$/ p /*/ manyTill p end
36
36
37-- | Zero or more occurences of @v@ separated by @s@.
37-- | Zero or more occurences of @v@ separated by @s@.
38−sepBy :: SemiIsoAlternative f => f a -> f () -> f [a]
38+sepBy :: SIArrow cat => cat () a -> cat () () -> cat () [a]
39−sepBy v s = sepBy1 v s /|/ sipure _Empty
39+sepBy v s = sepBy1 v s /+/ sipure _Empty
40
40
41-- | One or more occurences of @v@ separated by @s@.
41-- | One or more occurences of @v@ separated by @s@.
42−sepBy1 :: SemiIsoAlternative f => f a -> f () -> f [a]
42+sepBy1 :: SIArrow cat => cat () a -> cat () () -> cat () [a]
43−sepBy1 v s = _Cons /$/ v /*/ (s */ sepBy1 v s /|/ sipure _Empty)
43+sepBy1 v s = _Cons /$/ v /*/ (s */ sepBy1 v s /+/ sipure _Empty)
44
44
45-- | Tries to apply the actions in the list in order, until one of
45-- | Tries to apply the actions in the list in order, until one of
46-- them succeeds. Returns the value of the succeeding action.
46-- them succeeds. Returns the value of the succeeding action.
47−choice :: SemiIsoAlternative f => [f a] -> f a
47+choice :: SIArrow cat => [cat () a] -> cat () a
48−choice = foldr (/|/) (sifail "choice: all alternatives failed")
48+choice = foldr (/+/) (sifail "choice: all alternatives failed")
49
49
50-- | Combine two alternatives.
50-- | Combine two alternatives.
51−eitherOf :: SemiIsoAlternative f => f a -> f b -> f (Either a b)
51+eitherOf :: SIArrow cat => cat () a -> cat () b -> cat () (Either a b)
52−eitherOf a b = _Left /$/ a /|/ _Right /$/ b
52+eitherOf a b = _Left /$/ a /+/ _Right /$/ b
Data/Syntax/Indent.hs+37−44
@@ -1,16 +1,16 @@
1+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
1{-# LANGUAGE FlexibleInstances #-}
2{-# LANGUAGE FlexibleInstances #-}
2−{-# LANGUAGE UndecidableInstances #-}
3+{-# LANGUAGE TypeFamilies #-}
3−{-# LANGUAGE MultiParamTypeClasses #-}
4{- |
4{- |
5Module : Data.Syntax.Indent
5Module : Data.Syntax.Indent
6−Description : Indentation.
6+Description : Simple indentation.
7Copyright : (c) Paweł Nowak
7Copyright : (c) Paweł Nowak
8License : MIT
8License : MIT
9
9
10Maintainer : Paweł Nowak <pawel834@gmail.com>
10Maintainer : Paweł Nowak <pawel834@gmail.com>
11Stability : experimental
11Stability : experimental
12
12
13−Provides a very simple indentation as a \"monad\" transformer.
13+Provides a very simple indentation as a category transformer (a functor from Cat to Cat).
14-}
14-}
15module Data.Syntax.Indent (
15module Data.Syntax.Indent (
16 Indent,
16 Indent,
@@ -19,59 +19,52 @@ module Data.Syntax.Indent (
19 indented
19 indented
20 ) where
20 ) where
21
21
22−import Data.SemiIsoFunctor
22+import Control.Category
23+import Control.Category.Reader
24+import Control.SIArrow
23import Data.Syntax
25import Data.Syntax
24import Data.Syntax.Char
26import Data.Syntax.Char
25import Data.Syntax.Combinator
27import Data.Syntax.Combinator
26−import Prelude hiding (takeWhile, take)
28+import Prelude hiding (takeWhile, take, id, (.))
27
29
28-- | Adds indentation to a syntax description.
30-- | Adds indentation to a syntax description.
29−newtype Indent m a = Indent { unIndent :: (Int, m ()) -> m a }
31+newtype Indent cat a b = Indent { unIndent :: ReaderCT (Int, cat () ()) cat a b }
32+ deriving (Category, Products, Coproducts, CategoryPlus, SIArrow)
30
33
31−instance SemiIsoFunctor m => SemiIsoFunctor (Indent m) where
34+instance CategoryTrans Indent where
32− simap f (Indent g) = Indent $ \i -> simap f (g i)
35+ clift = Indent . clift
33
36
34−instance SemiIsoApply m => SemiIsoApply (Indent m) where
37+instance Syntax syn => Syntax (Indent syn) where
35− sipure ai = Indent $ \_ -> sipure ai
38+ type Seq (Indent syn) = Seq syn
36− Indent f /*/ Indent g = Indent $ \i -> f i /*/ g i
39+ anyChar = clift anyChar
40+ char = clift . char
41+ notChar = clift . notChar
42+ satisfy = clift . satisfy
43+ satisfyWith ai = clift . satisfyWith ai
44+ string = clift . string
45+ take = clift . take
46+ takeWhile = clift . takeWhile
47+ takeWhile1 = clift . takeWhile1
48+ takeTill = clift . takeTill
49+ takeTill1 = clift . takeTill1
37
50
38−instance SemiIsoAlternative m => SemiIsoAlternative (Indent m) where
51+instance SyntaxChar syn => SyntaxChar (Indent syn) where
39− siempty = Indent $ \_ -> siempty
52+ decimal = clift decimal
40− Indent f /|/ Indent g = Indent $ \i -> f i /|/ g i
53+ hexadecimal = clift hexadecimal
41−
54+ scientific = clift scientific
42−instance SemiIsoMonad m => SemiIsoMonad (Indent m) where
55+ realFloat = clift realFloat
43− (Indent m) //= f = Indent $ \i -> m i //= (\x -> unIndent (f x) i)
44−
45−instance SemiIsoFix m => SemiIsoFix (Indent m) where
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
64
56
65-- | @runIndent m tab@ runs the 'Indent' transformer using @tab@ once for each
57-- | @runIndent m tab@ runs the 'Indent' transformer using @tab@ once for each
66-- level of indentation.
58-- level of indentation.
67−runIndent :: Indent m a -> m () -> m a
59+runIndent :: Indent cat a b -> cat () () -> cat a b
68−runIndent = ($ 0) . curry . unIndent
60+runIndent (Indent m) tab = runReaderCT m (0, tab)
69
61
70-- | Inserts a new line and correct indentation, but does not
62-- | Inserts a new line and correct indentation, but does not
71-- require any formatting when parsing (it just skips all white space).
63-- require any formatting when parsing (it just skips all white space).
72−breakLine :: SyntaxChar syn seq => Indent syn ()
64+breakLine :: SyntaxChar syn => Indent syn () ()
65+breakLine = Indent . ReaderCT $ \(i, tab) ->
73−breakLine = Indent $ \(i, tab) -> opt (char '\n') /* opt (sireplicate_ i tab) /* spaces_
66+ opt (char '\n') /* opt (sireplicate_ i tab) /* spaces_
74
67
75-- | Increases the indentation level of its argument by one.
68-- | Increases the indentation level of its argument by one.
76−indented :: Indent m a -> Indent m a
69+indented :: Indent cat a b -> Indent cat a b
77−indented (Indent f) = Indent $ \(i, tab) -> f (i + 1, tab)
70+indented (Indent f) = Indent . ReaderCT $ \(i, tab) -> runReaderCT f (i + 1, tab)
syntax.cabal+2−2
@@ -1,5 +1,5 @@
1name: syntax
1name: syntax
2−version: 0.3.0.0
2+version: 1.0.0.0
3synopsis: Syntax descriptions for unified parsing and pretty-printing.
3synopsis: 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.
@@ -46,5 +46,5 @@ library
46 Data.Syntax.Char
46 Data.Syntax.Char
47 Data.Syntax.Combinator
47 Data.Syntax.Combinator
48 Data.Syntax.Indent
48 Data.Syntax.Indent
49− build-depends: base >= 4 && < 5, mono-traversable, lens >= 4, semi-iso >= 0.5.0, scientific >= 0.3, text
49+ build-depends: base >= 4 && < 5, mono-traversable, lens >= 4, semi-iso >= 1.0.0.0, scientific >= 0.3, text
50 default-language: Haskell2010
50 default-language: Haskell2010