bidirectional (empty) → 0.1.0.0

raw patch · 7 files changed

+312/−0 lines, 7 filesdep +basedep +bidirectionaldep +hedgehogsetup-changed

Dependencies added: base, bidirectional, hedgehog, mtl, profunctors

Files

CHANGELOG.md +5/−0
LICENSE +30/−0
README.md +63/−0
Setup.hs +2/−0
bidirectional.cabal +42/−0
src/Data/IParser.hs +94/−0
test/Main.hs +76/−0

+ CHANGELOG.md view

@@ -0,0 +1,5 @@+# Revision history for bidirectional++## 0.1.0.0 -- 2020-10-07++* First version. Released on an unsuspecting world.

+ LICENSE view

@@ -0,0 +1,30 @@+Copyright (c) 2020, Mats Rauhala++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++    * Redistributions of source code must retain the above copyright+      notice, this list of conditions and the following disclaimer.++    * Redistributions in binary form must reproduce the above+      copyright notice, this list of conditions and the following+      disclaimer in the documentation and/or other materials provided+      with the distribution.++    * Neither the name of Mats Rauhala nor the names of other+      contributors may be used to endorse or promote products derived+      from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

+ README.md view

@@ -0,0 +1,63 @@+# Bidirectional - bidirectional parsing++This library is based on the [blog](https://blog.poisson.chat/posts/2017-01-01-monadic-profunctors.html) by Lysxia.++In it they define a bidirectional parser that can both generate and consume+values.++Imagine that you have a record `Person` and you want to serialize it into a+list and deserialize it back.++``` haskell+data Person = Person { name :: String, age :: Int }+```+++The parser is parameterized over the parsing and generation contexts, these+needs to be selected carefully when implementing the parsers. It could be for+example a `RowParser` `Writer [SQLData]` combination for sqlite-simple, or a+simple state and writer for our running example.++So, let's figure out the context for our example. We want to encode into a list+and then decode the list back into a value.++``` haskell+type SimpleParser a = IParser (StateT [String] Maybe) (Writer [String]) a a+```++Then we create the parsers using the `parser` function.++``` haskell+int :: SimpleParser Int+int =+  parser+    (StateT $ \(x:xs) -> (,xs) <$> readMaybe x)+    (\x -> x <$ tell [show x])++string :: SimpleParser String+string =+  parser+    (StateT $ \(x:xs) -> Just (x,xs))+    (\x -> x <$ tell [x])+```++One small detail for creating records, is that the encoder gets the full record+structure by default, so you need to focus in on a specific part of the record+using the `(.=)` function.++``` haskell+person :: SimpleParser Person+person =+  Person <$> name .= string+         <*> age .= int+```++And now you can use your encoders and decoders++```+> execWriter (encode person (Person "foo" 30))+["foo", "30"]++> evalStateT (decode person ["foo", "30"])+Just (Person { name = "foo", age = 30 })+```

+ Setup.hs view

@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain

+ bidirectional.cabal view

@@ -0,0 +1,42 @@+cabal-version:       2.0+-- Initial package description 'bidirectional.cabal' generated by 'cabal+-- init'.  For further documentation, see+-- http://haskell.org/cabal/users-guide/++name:                bidirectional+version:             0.1.0.0+synopsis:            Simple bidirectional serialization and deserialization+description:         Bidirectional serialization based on https://blog.poisson.chat/posts/2017-01-01-monadic-profunctors.html+bug-reports:         https://github.com/MasseR/bidirectional/issues+license:             BSD3+license-file:        LICENSE+author:              Mats Rauhala+maintainer:          mats.rauhala@iki.fi+-- copyright:+category:            Codec+build-type:          Simple+extra-source-files:  CHANGELOG.md+                     README.md++source-repository head+  type: git+  location: https://github.com/MasseR/bidirectional++library+  exposed-modules:     Data.IParser+  -- other-modules:+  -- other-extensions:+  build-depends:       base >=4.10.0.0 && < 4.14+                     , profunctors >= 5 && < 5.6+  hs-source-dirs:      src+  default-language:    Haskell2010++test-suite bidirectional-test+  default-language:    Haskell2010+  type:                exitcode-stdio-1.0+  hs-source-dirs:      test+  main-is:             Main.hs+  build-depends:       base >=4.10.0.0 && < 4.14+                     , hedgehog+                     , bidirectional+                     , mtl

+ src/Data/IParser.hs view

@@ -0,0 +1,94 @@+{-# LANGUAGE Safe #-}+{-|+Module      : Data.IParser+Description : Bidirectional parsing+Copyright   : (c) Mats Rauhala, 2020+License     : BSD-3+Maintainer  : mats.rauhala@iki.fi+Stability   : experimental+Portability : POSIX++Let's assume we have a parser like the following++@+int :: Parser (ReaderT String Maybe) (Writer [Int]) Int Int+int = parser (ReaderT readMaybe) (\x -> x <$ tell [show x])+@++Then you can use the parser for parsing:++@+> runReaderT (decode int) "3"+Just 3+@++Or for encoding:++@+> execWriter (encode int 3)+["3"]+@++Or combine both of them++@+> runReaderT (decode int) $ head $ execWriter $ encode int 3+Just 3+@+-}+module Data.IParser where++import Data.Profunctor++-- | The core bidirectional parser type+--+-- See the module for usage example+--+data IParser r w c a =+  IParser { decoder :: r a -- ^ Return a value "a" in context "r".+          , encoder :: Star w c a -- ^ Generate a value "a" from the initial object "c" in the context "w"+          }++-- | Smart constructor for the parser+parser+  :: r a -- ^ The parser+  -> (c -> w a) -- ^ The encoder+  -> IParser r w c a+parser dec enc = IParser { decoder = dec, encoder = Star enc }++-- | Extract the decoder from the parser+decode :: IParser r w c a -> r a+decode = decoder++-- | Extract the encoder from the parser+encode :: IParser r w c a -> c -> w a+encode = runStar . encoder++-- | Record accessor helper+--+-- Due to the nature of the parser, the encoder gets the full record type, when+-- it should only focus on a specific part.+--+-- @+-- data Person = Person { name :: String, age :: Int }+--+-- person :: IParser r w Person Person+-- person =+--  Person <$> name .= string+--         <*> age .= int+-- @+(.=) :: (Functor r, Functor w) => (c -> c') -> IParser r w c' a -> IParser r w c a+(.=) = lmap++instance (Functor w, Functor r) => Functor (IParser r w c) where+  fmap f i = IParser { decoder = f <$> decoder i+                     , encoder = f <$> encoder i+                     }++instance (Applicative w, Applicative r) => Applicative (IParser r w c) where+  pure x = IParser { decoder = pure x, encoder = pure x }+  fx <*> x = IParser { decoder = decoder fx <*> decoder x, encoder = encoder fx <*> encoder x }++instance (Functor r, Functor w) => Profunctor (IParser r w) where+  dimap f g i = IParser { decoder = g <$> decoder i, encoder = dimap f g (encoder i) }+

+ test/Main.hs view

@@ -0,0 +1,76 @@+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE TupleSections #-}+module Main (main) where++import System.Exit+       (exitFailure, exitSuccess)++import Data.Functor.Identity++import Hedgehog++import qualified Hedgehog.Gen as Gen+import qualified Hedgehog.Range as Range++import Control.Monad.Reader+       (ReaderT(..), runReaderT)+import Control.Monad.State+       (StateT(..), evalStateT)+import Control.Monad.Writer+       (Writer, execWriter, tell)+import Text.Read+       (readMaybe)++import Data.IParser++-- fmap id == id+prop_functor_identity :: Property+prop_functor_identity = property $ do+  x <- forAll $ Gen.integral (Range.linear 0 100)+  let p = parser (pure x) pure :: IParser Identity Identity Int Int+  decode (fmap id p) === id (decode p)+  encode (fmap id p) x === id (encode p x)++-- fmap (f . g) == fmap f . fmap g+prop_functor_composition :: Property+prop_functor_composition = property $ do+  x <- forAll $ Gen.integral (Range.linear 0 100)+  y <- forAll $ Gen.integral (Range.linear 0 100)+  z <- forAll $ Gen.integral (Range.linear 0 100)+  let p = parser (pure val) pure :: IParser Identity Identity (Int, (Int, Int)) (Int, (Int, Int))+      f = fst+      g = snd+      val = (x,(y,z))+  decode (fmap (f . g) p) === decode (fmap f . fmap g $ p)+  encode (fmap (f . g) p) val === encode (fmap f . fmap g $ p) val++-- pure id <*> v+prop_applicative_identity :: Property+prop_applicative_identity = property $ do+  x <- forAll $ Gen.integral (Range.linear 0 100)+  let p = pure x :: IParser Identity Identity Int Int+  decode (pure id <*> p) === pure x++prop_bidirectional :: Property+prop_bidirectional = property $ do+  x <- forAll $ Gen.integral (Range.linear 0 100)+  let int = parser (ReaderT readMaybe) (\x -> x <$ tell [show x])+  runReaderT (decode int) (head (execWriter (encode int x))) === Just x++data Person+  = Person { name :: String, age :: Int }+  deriving (Show, Eq)++prop_compose :: Property+prop_compose = property $ do+  person <- forAll (Person <$> Gen.string (Range.linear 0 10) Gen.unicode <*> Gen.integral (Range.linear 10 30))+  let int = parser (StateT $ \(x:xs) -> (,xs) <$> readMaybe x) (\x -> x <$ tell [show x])+      string = parser (StateT $ \(x:xs) -> Just (x,xs)) (\x -> x <$ tell [x])+      p = Person <$> name .= string <*> age .= int+      encoded = execWriter (encode p person)+  evalStateT (decode p) encoded === Just person++main :: IO ()+main = do+  result <- checkParallel $$(discover)+  if result then exitSuccess else exitFailure