diff --git a/Data/Syntax/Attoparsec/ByteString.hs b/Data/Syntax/Attoparsec/ByteString.hs --- a/Data/Syntax/Attoparsec/ByteString.hs +++ b/Data/Syntax/Attoparsec/ByteString.hs @@ -1,5 +1,4 @@ -{-# LANGUAGE PatternSynonyms #-} -{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE TypeFamilies #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {- | Module : Data.Syntax.Attoparsec.ByteString @@ -14,33 +13,55 @@ -} module Data.Syntax.Attoparsec.ByteString ( WrappedParser, - getParser + getParser, + getParser_ ) where +import Control.Arrow (Kleisli(..)) +import Control.Category +import Control.Category.Structures import Control.Monad +import Control.SIArrow import qualified Data.Attoparsec.ByteString as AP import Data.ByteString (ByteString) -import Data.SemiIsoFunctor -import Data.SemiIsoFunctor.Wrapped import Data.Syntax +import qualified Data.Vector as V +import qualified Data.Vector.Unboxed as VU +import Prelude hiding (id, (.)) -- | A wrapped 'Data.Attoparsec.ByteString.Parser'. -newtype WrappedParser a = Wrapped (WrappedCovariant AP.Parser a) - deriving (SemiIsoFunctor, SemiIsoApply, SemiIsoAlternative, SemiIsoMonad) +newtype WrappedParser a b = Wrapped (Kleisli AP.Parser a b) + deriving (Category, Products, Coproducts, CatPlus, SIArrow) -pattern Parser a = Wrapped (WrappedCovariant a) +wrap :: AP.Parser b -> WrappedParser a b +wrap = Wrapped . Kleisli . const -instance Syntax WrappedParser ByteString where - anyChar = Parser AP.anyWord8 - char = Parser . void . AP.word8 - notChar = Parser . AP.notWord8 - satisfy = Parser . AP.satisfy - string = Parser . void . AP.string - take = Parser . AP.take - takeWhile = Parser . AP.takeWhile - takeWhile1 = Parser . AP.takeWhile1 - takeTill = Parser . AP.takeTill +unwrap :: WrappedParser a b -> a -> AP.Parser b +unwrap (Wrapped f) = runKleisli f +instance Syntax WrappedParser where + type Seq WrappedParser = ByteString + anyChar = wrap AP.anyWord8 + char = wrap . void . AP.word8 + notChar = wrap . AP.notWord8 + satisfy = wrap . AP.satisfy + string = wrap . void . AP.string + take = wrap . AP.take + takeWhile = wrap . AP.takeWhile + takeWhile1 = wrap . AP.takeWhile1 + takeTill = wrap . AP.takeTill + vecN n f = wrap $ V.replicateM n $ unwrap f () + ivecN n f = wrap $ V.generateM n $ fmap snd . unwrap f + uvecN n f = wrap $ VU.replicateM n $ unwrap f () + uivecN n f = wrap $ VU.generateM n $ fmap snd . unwrap f + +instance Isolable WrappedParser where + isolate p = Wrapped $ Kleisli $ either fail return . AP.parseOnly (unwrap p ()) + -- | Extracts the parser. -getParser :: WrappedParser a -> AP.Parser a -getParser (Parser a) = a +getParser :: WrappedParser a b -> a -> AP.Parser b +getParser (Wrapped (Kleisli f)) = f + +-- | Extracts the parser. +getParser_ :: WrappedParser () b -> AP.Parser b +getParser_ (Wrapped (Kleisli f)) = f () diff --git a/Data/Syntax/Attoparsec/ByteString/Lazy.hs b/Data/Syntax/Attoparsec/ByteString/Lazy.hs new file mode 100644 --- /dev/null +++ b/Data/Syntax/Attoparsec/ByteString/Lazy.hs @@ -0,0 +1,67 @@ +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} +{- | +Module : Data.Syntax.Attoparsec.ByteString.Lazy +Description : Syntax instance for Attoparsec.ByteString.Lazy.Parser. +Copyright : (c) Paweł Nowak +License : MIT + +Maintainer : Paweł Nowak +Stability : experimental + +Provides a Syntax instance for Attoparsec.ByteString.Lazy.Parser. +-} +module Data.Syntax.Attoparsec.ByteString.Lazy ( + WrappedParser, + getParser, + getParser_ + ) where + +import Control.Arrow (Kleisli(..)) +import Control.Category +import Control.Category.Structures +import Control.Monad +import Control.SIArrow +import qualified Data.Attoparsec.ByteString.Lazy as AP +import Data.ByteString (ByteString) +import Data.Syntax +import qualified Data.Vector as V +import qualified Data.Vector.Unboxed as VU +import Prelude hiding (id, (.)) + +-- | A wrapped 'Data.Attoparsec.ByteString.Parser'. +newtype WrappedParser a b = Wrapped (Kleisli AP.Parser a b) + deriving (Category, Products, Coproducts, CatPlus, SIArrow) + +wrap :: AP.Parser b -> WrappedParser a b +wrap = Wrapped . Kleisli . const + +unwrap :: WrappedParser a b -> a -> AP.Parser b +unwrap (Wrapped f) = runKleisli f + +instance Syntax WrappedParser where + type Seq WrappedParser = ByteString + anyChar = wrap AP.anyWord8 + char = wrap . void . AP.word8 + notChar = wrap . AP.notWord8 + satisfy = wrap . AP.satisfy + string = wrap . void . AP.string + take = wrap . AP.take + takeWhile = wrap . AP.takeWhile + takeWhile1 = wrap . AP.takeWhile1 + takeTill = wrap . AP.takeTill + vecN n f = wrap $ V.replicateM n $ unwrap f () + ivecN n f = wrap $ V.generateM n $ fmap snd . unwrap f + uvecN n f = wrap $ VU.replicateM n $ unwrap f () + uivecN n f = wrap $ VU.generateM n $ fmap snd . unwrap f + +instance Isolable WrappedParser where + isolate p = Wrapped $ Kleisli $ either fail return . AP.parseOnly (unwrap p ()) + +-- | Extracts the parser. +getParser :: WrappedParser a b -> a -> AP.Parser b +getParser (Wrapped (Kleisli f)) = f + +-- | Extracts the parser. +getParser_ :: WrappedParser () b -> AP.Parser b +getParser_ (Wrapped (Kleisli f)) = f () diff --git a/Data/Syntax/Attoparsec/Text.hs b/Data/Syntax/Attoparsec/Text.hs --- a/Data/Syntax/Attoparsec/Text.hs +++ b/Data/Syntax/Attoparsec/Text.hs @@ -1,5 +1,4 @@ -{-# LANGUAGE PatternSynonyms #-} -{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE TypeFamilies #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {- | Module : Data.Syntax.Attoparsec.Text @@ -14,41 +13,63 @@ -} module Data.Syntax.Attoparsec.Text ( WrappedParser, - getParser + getParser, + getParser_ ) where +import Control.Arrow (Kleisli(..)) +import Control.Category +import Control.Category.Structures import Control.Monad +import Control.SIArrow import qualified Data.Attoparsec.Text as AP import Data.Scientific -import Data.SemiIsoFunctor -import Data.SemiIsoFunctor.Wrapped import Data.Syntax import Data.Syntax.Char import Data.Text (Text) +import qualified Data.Vector as V +import qualified Data.Vector.Unboxed as VU +import Prelude hiding (id, (.)) -- | A wrapped 'Data.Attoparsec.Text.Parser'. -newtype WrappedParser a = Wrapped (WrappedCovariant AP.Parser a) - deriving (SemiIsoFunctor, SemiIsoApply, SemiIsoAlternative, SemiIsoMonad) +newtype WrappedParser a b = Wrapped (Kleisli AP.Parser a b) + deriving (Category, Products, Coproducts, CatPlus, SIArrow) -pattern Parser a = Wrapped (WrappedCovariant a) +wrap :: AP.Parser b -> WrappedParser a b +wrap = Wrapped . Kleisli . const -instance Syntax WrappedParser Text where - anyChar = Parser AP.anyChar - char = Parser . void . AP.char - notChar = Parser . AP.notChar - satisfy = Parser . AP.satisfy - string = Parser . void . AP.string - take = Parser . AP.take - takeWhile = Parser . AP.takeWhile - takeWhile1 = Parser . AP.takeWhile1 - takeTill = Parser . AP.takeTill +unwrap :: WrappedParser a b -> a -> AP.Parser b +unwrap (Wrapped f) = runKleisli f -instance SyntaxChar WrappedParser Text where - decimal = Parser AP.decimal - hexadecimal = Parser AP.hexadecimal - realFloat = Parser $ fmap toRealFloat AP.scientific - scientific = Parser AP.scientific +instance Syntax WrappedParser where + type Seq WrappedParser = Text + anyChar = wrap AP.anyChar + char = wrap . void . AP.char + notChar = wrap . AP.notChar + satisfy = wrap . AP.satisfy + string = wrap . void . AP.string + take = wrap . AP.take + takeWhile = wrap . AP.takeWhile + takeWhile1 = wrap . AP.takeWhile1 + takeTill = wrap . AP.takeTill + vecN n f = wrap $ V.replicateM n $ unwrap f () + ivecN n f = wrap $ V.generateM n $ fmap snd . unwrap f + uvecN n f = wrap $ VU.replicateM n $ unwrap f () + uivecN n f = wrap $ VU.generateM n $ fmap snd . unwrap f +instance Isolable WrappedParser where + isolate p = Wrapped $ Kleisli $ either fail return . AP.parseOnly (unwrap p ()) + +instance SyntaxChar WrappedParser where + decimal = wrap AP.decimal + hexadecimal = wrap AP.hexadecimal + realFloat = wrap $ fmap toRealFloat AP.scientific + scientific = wrap AP.scientific + -- | Extracts the parser. -getParser :: WrappedParser a -> AP.Parser a -getParser (Parser m) = m +getParser :: WrappedParser a b -> a -> AP.Parser b +getParser (Wrapped (Kleisli f)) = f + +-- | Extracts the parser. +getParser_ :: WrappedParser () b -> AP.Parser b +getParser_ (Wrapped (Kleisli f)) = f () diff --git a/Data/Syntax/Attoparsec/Text/Lazy.hs b/Data/Syntax/Attoparsec/Text/Lazy.hs --- a/Data/Syntax/Attoparsec/Text/Lazy.hs +++ b/Data/Syntax/Attoparsec/Text/Lazy.hs @@ -1,5 +1,4 @@ -{-# LANGUAGE PatternSynonyms #-} -{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE TypeFamilies #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {- | Module : Data.Syntax.Attoparsec.Text.Laxy @@ -14,41 +13,63 @@ -} module Data.Syntax.Attoparsec.Text.Lazy ( WrappedParser, - getParser + getParser, + getParser_ ) where +import Control.Arrow (Kleisli(..)) +import Control.Category +import Control.Category.Structures import Control.Monad +import Control.SIArrow import qualified Data.Attoparsec.Text.Lazy as AP import Data.Scientific -import Data.SemiIsoFunctor -import Data.SemiIsoFunctor.Wrapped import Data.Syntax import Data.Syntax.Char import Data.Text (Text) +import qualified Data.Vector as V +import qualified Data.Vector.Unboxed as VU +import Prelude hiding (id, (.)) -- | A wrapped 'Data.Attoparsec.Text.Parser'. -newtype WrappedParser a = Wrapped (WrappedCovariant AP.Parser a) - deriving (SemiIsoFunctor, SemiIsoApply, SemiIsoAlternative, SemiIsoMonad) +newtype WrappedParser a b = Wrapped (Kleisli AP.Parser a b) + deriving (Category, Products, Coproducts, CatPlus, SIArrow) -pattern Parser a = Wrapped (WrappedCovariant a) +wrap :: AP.Parser b -> WrappedParser a b +wrap = Wrapped . Kleisli . const -instance Syntax WrappedParser Text where - anyChar = Parser AP.anyChar - char = Parser . void . AP.char - notChar = Parser . AP.notChar - satisfy = Parser . AP.satisfy - string = Parser . void . AP.string - take = Parser . AP.take - takeWhile = Parser . AP.takeWhile - takeWhile1 = Parser . AP.takeWhile1 - takeTill = Parser . AP.takeTill +unwrap :: WrappedParser a b -> a -> AP.Parser b +unwrap (Wrapped f) = runKleisli f -instance SyntaxChar WrappedParser Text where - decimal = Parser AP.decimal - hexadecimal = Parser AP.hexadecimal - realFloat = Parser $ fmap toRealFloat AP.scientific - scientific = Parser AP.scientific +instance Syntax WrappedParser where + type Seq WrappedParser = Text + anyChar = wrap AP.anyChar + char = wrap . void . AP.char + notChar = wrap . AP.notChar + satisfy = wrap . AP.satisfy + string = wrap . void . AP.string + take = wrap . AP.take + takeWhile = wrap . AP.takeWhile + takeWhile1 = wrap . AP.takeWhile1 + takeTill = wrap . AP.takeTill + vecN n f = wrap $ V.replicateM n $ unwrap f () + ivecN n f = wrap $ V.generateM n $ fmap snd . unwrap f + uvecN n f = wrap $ VU.replicateM n $ unwrap f () + uivecN n f = wrap $ VU.generateM n $ fmap snd . unwrap f +instance Isolable WrappedParser where + isolate p = Wrapped $ Kleisli $ either fail return . AP.parseOnly (unwrap p ()) + +instance SyntaxChar WrappedParser where + decimal = wrap AP.decimal + hexadecimal = wrap AP.hexadecimal + realFloat = wrap $ fmap toRealFloat AP.scientific + scientific = wrap AP.scientific + -- | Extracts the parser. -getParser :: WrappedParser a -> AP.Parser a -getParser (Parser m) = m +getParser :: WrappedParser a b -> a -> AP.Parser b +getParser (Wrapped (Kleisli f)) = f + +-- | Extracts the parser. +getParser_ :: WrappedParser () b -> AP.Parser b +getParser_ (Wrapped (Kleisli f)) = f () diff --git a/syntax-attoparsec.cabal b/syntax-attoparsec.cabal --- a/syntax-attoparsec.cabal +++ b/syntax-attoparsec.cabal @@ -1,5 +1,5 @@ name: syntax-attoparsec -version: 0.3.0.0 +version: 1.0.0.0 synopsis: Syntax instances for Attoparsec. license: MIT license-file: LICENSE @@ -18,5 +18,7 @@ exposed-modules: Data.Syntax.Attoparsec.Text Data.Syntax.Attoparsec.Text.Lazy Data.Syntax.Attoparsec.ByteString - build-depends: base >= 4 && < 5, syntax >= 0.3, semi-iso >= 0.5, attoparsec, text, bytestring, scientific + Data.Syntax.Attoparsec.ByteString.Lazy + build-depends: base >= 4 && < 5, syntax >= 1, semi-iso >= 1, attoparsec, text, bytestring, scientific, vector default-language: Haskell2010 + ghc-options: -Wall