on master help sign in
Add instances for Syntax and SyntaxChar.
c083497Paweł Nowak
Data/Syntax.hs+16−1
@@ -21,6 +21,7 @@ module Data.Syntax (
21
21
22import Prelude hiding (take, takeWhile)
22import Prelude hiding (take, takeWhile)
23
23
24+import Control.Category.Reader
24import Control.Lens.Iso
25import Control.Lens.Iso
25import Control.Lens.SemiIso
26import Control.Lens.SemiIso
26import Control.SIArrow
27import Control.SIArrow
@@ -70,7 +71,7 @@ class ( SIArrow syn
70 satisfyWith ai p = bifiltered p . ai /$/ anyChar
71 satisfyWith ai p = bifiltered p . ai /$/ anyChar
71
72
72 -- | A specific string.
73 -- | A specific string.
73− string :: (Seq syn) -> syn () ()
74+ string :: Seq syn -> syn () ()
74 string s = rev (exact s) /$/ take (olength s)
75 string s = rev (exact s) /$/ take (olength s)
75
76
76 -- | A string of length @n@.
77 -- | A string of length @n@.
@@ -94,3 +95,17 @@ class ( SIArrow syn
94 takeTill1 p = takeWhile1 (not . p)
95 takeTill1 p = takeWhile1 (not . p)
95
96
96 {-# MINIMAL anyChar #-}
97 {-# MINIMAL anyChar #-}
98+
99+instance Syntax syn => Syntax (ReaderCT env syn) where
100+ type Seq (ReaderCT env syn) = Seq syn
101+ anyChar = clift anyChar
102+ char = clift . char
103+ notChar = clift . notChar
104+ satisfy = clift . satisfy
105+ satisfyWith ai = clift . satisfyWith ai
106+ string = clift . string
107+ take = clift . take
108+ takeWhile = clift . takeWhile
109+ takeWhile1 = clift . takeWhile1
110+ takeTill = clift . takeTill
111+ takeTill1 = clift . takeTill1
Data/Syntax/Char.hs+7
@@ -25,6 +25,7 @@ module Data.Syntax.Char (
25 digitHex
25 digitHex
26 ) where
26 ) where
27
27
28+import Control.Category.Reader
28import Control.Lens.SemiIso
29import Control.Lens.SemiIso
29import Control.SIArrow
30import Control.SIArrow
30import Data.Bits
31import Data.Bits
@@ -54,6 +55,12 @@ class (Syntax syn, Element (Seq syn) ~ Char) => SyntaxChar syn where
54
55
55 {-# MINIMAL decimal, hexadecimal, realFloat, scientific #-}
56 {-# MINIMAL decimal, hexadecimal, realFloat, scientific #-}
56
57
58+instance SyntaxChar syn => SyntaxChar (ReaderCT env syn) where
59+ decimal = clift decimal
60+ hexadecimal = clift hexadecimal
61+ scientific = clift scientific
62+ realFloat = clift realFloat
63+
57-- | An useful synonym for SyntaxChars with Text sequences.
64-- | An useful synonym for SyntaxChars with Text sequences.
58type SyntaxText syn = (SyntaxChar syn, Seq syn ~ Text)
65type SyntaxText syn = (SyntaxChar syn, Seq syn ~ Text)
59
66
Data/Syntax/Indent.hs+17−15
@@ -34,25 +34,27 @@ newtype Indent cat a b = Indent { unIndent :: ReaderCT (Int, cat () ()) cat a b
34instance CategoryTrans Indent where
34instance CategoryTrans Indent where
35 clift = Indent . clift
35 clift = Indent . clift
36
36
37+-- Generalized newtype deriving cannot derive this :(
38+
37instance Syntax syn => Syntax (Indent syn) where
39instance Syntax syn => Syntax (Indent syn) where
38 type Seq (Indent syn) = Seq syn
40 type Seq (Indent syn) = Seq syn
39− anyChar = clift anyChar
41+ anyChar = Indent anyChar
40− char = clift . char
42+ char = Indent . char
41− notChar = clift . notChar
43+ notChar = Indent . notChar
42− satisfy = clift . satisfy
44+ satisfy = Indent . satisfy
43− satisfyWith ai = clift . satisfyWith ai
45+ satisfyWith ai = Indent . satisfyWith ai
44− string = clift . string
46+ string = Indent . string
45− take = clift . take
47+ take = Indent . take
46− takeWhile = clift . takeWhile
48+ takeWhile = Indent . takeWhile
47− takeWhile1 = clift . takeWhile1
49+ takeWhile1 = Indent . takeWhile1
48− takeTill = clift . takeTill
50+ takeTill = Indent . takeTill
49− takeTill1 = clift . takeTill1
51+ takeTill1 = Indent . takeTill1
50
52
51instance SyntaxChar syn => SyntaxChar (Indent syn) where
53instance SyntaxChar syn => SyntaxChar (Indent syn) where
52− decimal = clift decimal
54+ decimal = Indent decimal
53− hexadecimal = clift hexadecimal
55+ hexadecimal = Indent hexadecimal
54− scientific = clift scientific
56+ scientific = Indent scientific
55− realFloat = clift realFloat
57+ realFloat = Indent realFloat
56
58
57-- | @runIndent m tab@ runs the 'Indent' transformer using @tab@ once for each
59-- | @runIndent m tab@ runs the 'Indent' transformer using @tab@ once for each
58-- level of indentation.
60-- level of indentation.