syntax-printer 0.1.0.0 → 1.0.0.0

raw patch · 6 files changed

+241/−80 lines, 6 filesdep +bifunctorsdep +semigroupoidsdep +vectordep ~semi-isodep ~syntaxPVP ok

version bump matches the API change (PVP)

Dependencies added: bifunctors, semigroupoids, vector

Dependency ranges changed: semi-iso, syntax

API changes (from Hackage documentation)

Files

• Data/Syntax/Printer/ByteString.hs +51/−14
• Data/Syntax/Printer/ByteString/Lazy.hs +51/−14
• Data/Syntax/Printer/Consumer.hs +25/−14
• Data/Syntax/Printer/Text.hs +56/−18
• Data/Syntax/Printer/Text/Lazy.hs +55/−18
• syntax-printer.cabal +3/−2

@@ -1,4 +1,5 @@-{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE TupleSections #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {- | Module      :  Data.Syntax.Printer.ByteString@@ -11,33 +12,69 @@ -} module Data.Syntax.Printer.ByteString (     Printer,-    runPrinter+    runPrinter,+    runPrinter_     )     where +import           Control.Arrow (Kleisli(..))+import           Control.Category+import           Control.Category.Structures import           Control.Monad+import           Control.SIArrow import           Data.ByteString (ByteString) import qualified Data.ByteString as BS+import           Data.ByteString.Lazy (toStrict) import           Data.ByteString.Lazy.Builder-import           Data.SemiIsoFunctor+import           Data.Monoid (mempty)+import           Data.Semigroupoid.Dual import           Data.Syntax import           Data.Syntax.Printer.Consumer+import qualified Data.Vector as V+import qualified Data.Vector.Unboxed as VU+import           Prelude hiding (id, (.)) --- | Prints a value to a Text Builder using a syntax description.-newtype Printer a = Printer { getConsumer :: Consumer Builder a }-    deriving (SemiIsoFunctor, SemiIsoApply, SemiIsoAlternative, SemiIsoMonad)+-- | Prints a value to a ByteString Builder using a syntax description.+newtype Printer a b = Printer { unPrinter :: Dual (Kleisli (Consumer Builder)) a b }+    deriving (Category, Products, Coproducts, CatPlus, SIArrow) -instance Syntax Printer ByteString where-    anyChar = Printer . Consumer $ Right . word8-    take n = Printer . Consumer $ Right . byteString . BS.take n-    takeWhile p = Printer . Consumer $ Right . byteString . BS.takeWhile p-    takeWhile1 p = Printer . Consumer $ Right . byteString <=< notNull . BS.takeWhile p+wrap :: (b -> Either String Builder) -> Printer () b+wrap f = Printer $ Dual $ Kleisli $ (Consumer . fmap (, ())) . f++unwrap :: Printer a b -> b -> Consumer Builder a+unwrap = runKleisli . getDual . unPrinter++instance Syntax Printer where+    type Seq Printer = ByteString+    anyChar = wrap $ Right . word8+    take n = wrap $ Right . byteString . BS.take n+    takeWhile p = wrap $ Right . byteString . BS.takeWhile p+    takeWhile1 p = wrap $ Right . byteString <=< notNull . BS.takeWhile p       where notNull t | BS.null t  = Left "takeWhile1 failed"                       | otherwise = Right t-    takeTill1 p = Printer . Consumer $ Right . byteString <=< notNull . BS.takeWhile (not . p)+    takeTill1 p = wrap $ Right . byteString <=< notNull . BS.takeWhile (not . p)       where notNull t | BS.null t  = Left "takeTill1 failed"                       | otherwise = Right t+    vecN n e = wrap $ \v -> if V.length v == n+                               then fmap fst $ runConsumer (V.mapM_ (unwrap e) v)+                               else Left "vecN: invalid vector size"+    ivecN n e = wrap $ \v -> if V.length v == n+                                then fmap fst $ runConsumer (V.mapM_ (unwrap e) (V.indexed v))+                                else Left "ivecN: invalid vector size"+    uvecN n e = wrap $ \v -> if VU.length v == n+                                then fmap fst $ runConsumer (VU.mapM_ (unwrap e) v)+                                else Left "uvecN: invalid vector size"+    uivecN n e = wrap $ \v -> if VU.length v == n+                                 then fmap fst $ runConsumer (VU.mapM_ (unwrap e) (VU.indexed v))+                                 else Left "uivecN: invalid vector size"+instance Isolable Printer where+    isolate p = Printer $ Dual $ Kleisli $+        Consumer . fmap ((mempty, ) . toStrict . toLazyByteString) . runPrinter_ p  -- | Runs the printer.-runPrinter :: Printer a -> a -> Either String Builder-runPrinter = runConsumer . getConsumer+runPrinter :: Printer a b -> b -> Either String (Builder, a)+runPrinter = (runConsumer .) . runKleisli . getDual . unPrinter++-- | Runs the printer and discards the result.+runPrinter_ :: Printer a b -> b -> Either String Builder+runPrinter_ = (fmap fst .) . runPrinter

@@ -1,4 +1,5 @@-{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE TupleSections #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {- | Module      :  Data.Syntax.Printer.ByteString.Lazy@@ -11,33 +12,69 @@ -} module Data.Syntax.Printer.ByteString.Lazy (     Printer,-    runPrinter+    runPrinter,+    runPrinter_     )     where +import           Control.Arrow (Kleisli(..))+import           Control.Category+import           Control.Category.Structures import           Control.Monad+import           Control.SIArrow import           Data.ByteString.Lazy (ByteString) import qualified Data.ByteString.Lazy as BS import           Data.ByteString.Lazy.Builder-import           Data.SemiIsoFunctor+import           Data.Monoid (mempty)+import           Data.Semigroupoid.Dual import           Data.Syntax import           Data.Syntax.Printer.Consumer+import qualified Data.Vector as V+import qualified Data.Vector.Unboxed as VU+import           Prelude hiding (id, (.)) --- | Prints a value to a Text Builder using a syntax description.-newtype Printer a = Printer { getConsumer :: Consumer Builder a }-    deriving (SemiIsoFunctor, SemiIsoApply, SemiIsoAlternative, SemiIsoMonad)+-- | Prints a value to a ByteString Builder using a syntax description.+newtype Printer a b = Printer { unPrinter :: Dual (Kleisli (Consumer Builder)) a b }+    deriving (Category, Products, Coproducts, CatPlus, SIArrow) -instance Syntax Printer ByteString where-    anyChar = Printer . Consumer $ Right . word8-    take n = Printer . Consumer $ Right . lazyByteString . BS.take (fromIntegral n)-    takeWhile p = Printer . Consumer $ Right . lazyByteString . BS.takeWhile p-    takeWhile1 p = Printer . Consumer $ Right . lazyByteString <=< notNull . BS.takeWhile p+wrap :: (b -> Either String Builder) -> Printer () b+wrap f = Printer $ Dual $ Kleisli $ (Consumer . fmap (, ())) . f++unwrap :: Printer a b -> b -> Consumer Builder a+unwrap = runKleisli . getDual . unPrinter++instance Syntax Printer where+    type Seq Printer = ByteString+    anyChar = wrap $ Right . word8+    take n = wrap $ Right . lazyByteString . BS.take (fromIntegral n)+    takeWhile p = wrap $ Right . lazyByteString . BS.takeWhile p+    takeWhile1 p = wrap $ Right . lazyByteString <=< notNull . BS.takeWhile p       where notNull t | BS.null t  = Left "takeWhile1 failed"                       | otherwise = Right t-    takeTill1 p = Printer . Consumer $ Right . lazyByteString <=< notNull . BS.takeWhile (not . p)+    takeTill1 p = wrap $ Right . lazyByteString <=< notNull . BS.takeWhile (not . p)       where notNull t | BS.null t  = Left "takeTill1 failed"                       | otherwise = Right t+    vecN n e = wrap $ \v -> if V.length v == n+                               then fmap fst $ runConsumer (V.mapM_ (unwrap e) v)+                               else Left "vecN: invalid vector size"+    ivecN n e = wrap $ \v -> if V.length v == n+                                then fmap fst $ runConsumer (V.mapM_ (unwrap e) (V.indexed v))+                                else Left "ivecN: invalid vector size"+    uvecN n e = wrap $ \v -> if VU.length v == n+                                then fmap fst $ runConsumer (VU.mapM_ (unwrap e) v)+                                else Left "uvecN: invalid vector size"+    uivecN n e = wrap $ \v -> if VU.length v == n+                                 then fmap fst $ runConsumer (VU.mapM_ (unwrap e) (VU.indexed v))+                                 else Left "uivecN: invalid vector size" +instance Isolable Printer where+    isolate p = Printer $ Dual $ Kleisli $+        Consumer . fmap ((mempty, ) . toLazyByteString) . runPrinter_ p+ -- | Runs the printer.-runPrinter :: Printer a -> a -> Either String Builder-runPrinter = runConsumer . getConsumer+runPrinter :: Printer a b -> b -> Either String (Builder, a)+runPrinter = (runConsumer .) . runKleisli . getDual . unPrinter++-- | Runs the printer and discards the result.+runPrinter_ :: Printer a b -> b -> Either String Builder+runPrinter_ = (fmap fst .) . runPrinter

@@ -1,3 +1,4 @@+{-# LANGUAGE DeriveFunctor #-} {- | Module      :  Data.Syntax.Printer.Consumer Description :  Common base for both Text and ByteString printers.@@ -10,24 +11,34 @@ module Data.Syntax.Printer.Consumer where  import Control.Applicative-import Control.Lens.SemiIso import Control.Monad+import Data.Bifunctor.Apply import Data.Monoid-import Data.SemiIsoFunctor --- | A contravariant functor that consumes values using a monoid.-newtype Consumer m a = Consumer { runConsumer :: a -> Either String m }+-- | A writer monad combined with Either String.+newtype Consumer m a = Consumer { runConsumer :: Either String (m, a) }+    deriving (Functor) -instance SemiIsoFunctor (Consumer m) where-    simap f (Consumer p) = Consumer $ apply f >=> p+instance Monoid m => Applicative (Consumer m) where+    pure x = Consumer $ Right (mempty, x)+    f <*> x = Consumer $ bilift2 (flip (<>)) ($) <$> runConsumer f <*> runConsumer x -instance Monoid m => SemiIsoApply (Consumer m) where-    siunit = Consumer $ \_ -> Right mempty-    Consumer f /*/ Consumer g = Consumer $ \(a, b) -> (<>) <$> f a <*> g b+instance Monoid m => Alternative (Consumer m) where+    empty = Consumer $ Left "empty"+    f <|> g = Consumer $ case runConsumer f of+                           Left _ -> case runConsumer g of+                                       Left e2 -> Left e2+                                       Right x -> Right x+                           Right x -> Right x -instance Monoid m => SemiIsoAlternative (Consumer m) where-    siempty = Consumer $ \_ -> Left "siempty"-    Consumer f /|/ Consumer g = Consumer $ \a -> f a <|> g a+instance Monoid m => Monad (Consumer m) where+    return = pure+    m >>= f = Consumer $ do+        (m1, x) <- runConsumer m+        (m2, y) <- runConsumer (f x)+        return (m2 <> m1, y)+    fail = Consumer . Left -instance Monoid m => SemiIsoMonad (Consumer m) where-    Consumer m //= f = Consumer $ \(a, b) -> (<>) <$> m a <*> runConsumer (f a) b+instance Monoid m => MonadPlus (Consumer m) where+    mzero = empty+    mplus = (<|>)

@@ -1,4 +1,5 @@-{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE TupleSections #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {- | Module      :  Data.Syntax.Printer.Text@@ -11,43 +12,80 @@ -} module Data.Syntax.Printer.Text (     Printer,-    runPrinter+    runPrinter,+    runPrinter_     )     where +import           Control.Arrow (Kleisli(..))+import           Control.Category+import           Control.Category.Structures import           Control.Monad-import           Data.SemiIsoFunctor+import           Control.SIArrow+import           Data.Monoid (mempty)+import           Data.Semigroupoid.Dual import           Data.Syntax import           Data.Syntax.Char import           Data.Syntax.Printer.Consumer import           Data.Text (Text) import qualified Data.Text as T+import           Data.Text.Lazy (toStrict) import           Data.Text.Lazy.Builder import qualified Data.Text.Lazy.Builder.Int as B import qualified Data.Text.Lazy.Builder.RealFloat as B import qualified Data.Text.Lazy.Builder.Scientific as B+import qualified Data.Vector as V+import qualified Data.Vector.Unboxed as VU+import           Prelude hiding (id, (.))  -- | Prints a value to a Text Builder using a syntax description.-newtype Printer a = Printer { getConsumer :: Consumer Builder a }-    deriving (SemiIsoFunctor, SemiIsoApply, SemiIsoAlternative, SemiIsoMonad)+newtype Printer a b = Printer { unPrinter :: Dual (Kleisli (Consumer Builder)) a b }+    deriving (Category, Products, Coproducts, CatPlus, SIArrow) -instance Syntax Printer Text where-    anyChar = Printer . Consumer $ Right . singleton-    take n = Printer . Consumer $ Right . fromText . T.take n-    takeWhile p = Printer . Consumer $ Right . fromText . T.takeWhile p-    takeWhile1 p = Printer . Consumer $ Right . fromText <=< notNull . T.takeWhile p+wrap :: (b -> Either String Builder) -> Printer () b+wrap f = Printer $ Dual $ Kleisli $ (Consumer . fmap (, ())) . f++unwrap :: Printer a b -> b -> Consumer Builder a+unwrap = runKleisli . getDual . unPrinter++instance Syntax Printer where+    type Seq Printer = Text+    anyChar = wrap $ Right . singleton+    take n = wrap $ Right . fromText . T.take n+    takeWhile p = wrap $ Right . fromText . T.takeWhile p+    takeWhile1 p = wrap $ Right . fromText <=< notNull . T.takeWhile p       where notNull t | T.null t  = Left "takeWhile1 failed"                       | otherwise = Right t-    takeTill1 p = Printer . Consumer $ Right . fromText <=< notNull . T.takeWhile (not . p)+    takeTill1 p = wrap $ Right . fromText <=< notNull . T.takeWhile (not . p)       where notNull t | T.null t  = Left "takeTill1 failed"                       | otherwise = Right t+    vecN n e = wrap $ \v -> if V.length v == n+                               then fmap fst $ runConsumer (V.mapM_ (unwrap e) v)+                               else Left "vecN: invalid vector size"+    ivecN n e = wrap $ \v -> if V.length v == n+                                then fmap fst $ runConsumer (V.mapM_ (unwrap e) (V.indexed v))+                                else Left "ivecN: invalid vector size"+    uvecN n e = wrap $ \v -> if VU.length v == n+                                then fmap fst $ runConsumer (VU.mapM_ (unwrap e) v)+                                else Left "uvecN: invalid vector size"+    uivecN n e = wrap $ \v -> if VU.length v == n+                                 then fmap fst $ runConsumer (VU.mapM_ (unwrap e) (VU.indexed v))+                                 else Left "uivecN: invalid vector size" -instance SyntaxChar Printer Text where-    decimal = Printer . Consumer $ Right . B.decimal-    hexadecimal = Printer . Consumer $ Right . B.hexadecimal-    realFloat = Printer . Consumer $ Right . B.realFloat-    scientific = Printer . Consumer $ Right . B.scientificBuilder+instance Isolable Printer where+    isolate p = Printer $ Dual $ Kleisli $+        Consumer . fmap ((mempty, ) . toStrict . toLazyText) . runPrinter_ p +instance SyntaxChar Printer where+    decimal = wrap $ Right . B.decimal+    hexadecimal = wrap $ Right . B.hexadecimal+    realFloat = wrap $ Right . B.realFloat+    scientific = wrap $ Right . B.scientificBuilder+ -- | Runs the printer.-runPrinter :: Printer a -> a -> Either String Builder-runPrinter = runConsumer . getConsumer+runPrinter :: Printer a b -> b -> Either String (Builder, a)+runPrinter = (runConsumer .) . runKleisli . getDual . unPrinter++-- | Runs the printer and discards the result.+runPrinter_ :: Printer a b -> b -> Either String Builder+runPrinter_ = (fmap fst .) . runPrinter

@@ -1,4 +1,5 @@-{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE TupleSections #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {- | Module      :  Data.Syntax.Printer.Text.Lazy@@ -11,12 +12,18 @@ -} module Data.Syntax.Printer.Text.Lazy (     Printer,-    runPrinter+    runPrinter,+    runPrinter_     )     where +import           Control.Arrow (Kleisli(..))+import           Control.Category+import           Control.Category.Structures import           Control.Monad-import           Data.SemiIsoFunctor+import           Control.SIArrow+import           Data.Monoid (mempty)+import           Data.Semigroupoid.Dual import           Data.Syntax import           Data.Syntax.Char import           Data.Syntax.Printer.Consumer@@ -26,28 +33,58 @@ import qualified Data.Text.Lazy.Builder.Int as B import qualified Data.Text.Lazy.Builder.RealFloat as B import qualified Data.Text.Lazy.Builder.Scientific as B+import qualified Data.Vector as V+import qualified Data.Vector.Unboxed as VU+import           Prelude hiding (id, (.))  -- | Prints a value to a Text Builder using a syntax description.-newtype Printer a = Printer { getConsumer :: Consumer Builder a }-    deriving (SemiIsoFunctor, SemiIsoApply, SemiIsoAlternative, SemiIsoMonad)+newtype Printer a b = Printer { unPrinter :: Dual (Kleisli (Consumer Builder)) a b }+    deriving (Category, Products, Coproducts, CatPlus, SIArrow) -instance Syntax Printer Text where-    anyChar = Printer . Consumer $ Right . singleton-    take n = Printer . Consumer $ Right . fromLazyText . T.take (fromIntegral n)-    takeWhile p = Printer . Consumer $ Right . fromLazyText . T.takeWhile p-    takeWhile1 p = Printer . Consumer $ Right . fromLazyText <=< notNull . T.takeWhile p+wrap :: (b -> Either String Builder) -> Printer () b+wrap f = Printer $ Dual $ Kleisli $ (Consumer . fmap (, ())) . f++unwrap :: Printer a b -> b -> Consumer Builder a+unwrap = runKleisli . getDual . unPrinter++instance Syntax Printer where+    type Seq Printer = Text+    anyChar = wrap $ Right . singleton+    take n = wrap $ Right . fromLazyText . T.take (fromIntegral n)+    takeWhile p = wrap $ Right . fromLazyText . T.takeWhile p+    takeWhile1 p = wrap $ Right . fromLazyText <=< notNull . T.takeWhile p       where notNull t | T.null t  = Left "takeWhile1 failed"                       | otherwise = Right t-    takeTill1 p = Printer . Consumer $ Right . fromLazyText <=< notNull . T.takeWhile (not . p)+    takeTill1 p = wrap $ Right . fromLazyText <=< notNull . T.takeWhile (not . p)       where notNull t | T.null t  = Left "takeTill1 failed"                       | otherwise = Right t+    vecN n e = wrap $ \v -> if V.length v == n+                               then fmap fst $ runConsumer (V.mapM_ (unwrap e) v)+                               else Left "vecN: invalid vector size"+    ivecN n e = wrap $ \v -> if V.length v == n+                                then fmap fst $ runConsumer (V.mapM_ (unwrap e) (V.indexed v))+                                else Left "ivecN: invalid vector size"+    uvecN n e = wrap $ \v -> if VU.length v == n+                                then fmap fst $ runConsumer (VU.mapM_ (unwrap e) v)+                                else Left "uvecN: invalid vector size"+    uivecN n e = wrap $ \v -> if VU.length v == n+                                 then fmap fst $ runConsumer (VU.mapM_ (unwrap e) (VU.indexed v))+                                 else Left "uivecN: invalid vector size" -instance SyntaxChar Printer Text where-    decimal = Printer . Consumer $ Right . B.decimal-    hexadecimal = Printer . Consumer $ Right . B.hexadecimal-    realFloat = Printer . Consumer $ Right . B.realFloat-    scientific = Printer . Consumer $ Right . B.scientificBuilder+instance Isolable Printer where+    isolate p = Printer $ Dual $ Kleisli $+        Consumer . fmap ((mempty, ) . toLazyText) . runPrinter_ p +instance SyntaxChar Printer where+    decimal = wrap $ Right . B.decimal+    hexadecimal = wrap $ Right . B.hexadecimal+    realFloat = wrap $ Right . B.realFloat+    scientific = wrap $ Right . B.scientificBuilder+ -- | Runs the printer.-runPrinter :: Printer a -> a -> Either String Builder-runPrinter = runConsumer . getConsumer+runPrinter :: Printer a b -> b -> Either String (Builder, a)+runPrinter = (runConsumer .) . runKleisli . getDual . unPrinter++-- | Runs the printer and discards the result.+runPrinter_ :: Printer a b -> b -> Either String Builder+runPrinter_ = (fmap fst .) . runPrinter

@@ -1,5 +1,5 @@ name:                syntax-printer-version:             0.1.0.0+version:             1.0.0.0 synopsis:            Text and ByteString printers for 'syntax'. license:             MIT license-file:        LICENSE@@ -16,6 +16,7 @@                        Data.Syntax.Printer.Text.Lazy                        Data.Syntax.Printer.ByteString                        Data.Syntax.Printer.ByteString.Lazy-  build-depends:       base >=4.7 && <4.8, semi-iso >= 0.5, syntax >= 0.3, text, bytestring, scientific >= 0.3+  build-depends:       base >=4.7 && <4.8, semi-iso >= 1, syntax >= 1,+                       text, bytestring, scientific >= 0.3, bifunctors, semigroupoids, vector   default-language:    Haskell2010   ghc-options:         -Wall