packages feed

siphon 0.2 → 0.6

raw patch · 5 files changed

+398/−94 lines, 5 filesdep +profunctorsdep ~colonnade

Dependencies added: profunctors

Dependency ranges changed: colonnade

Files

siphon.cabal view
@@ -1,6 +1,6 @@ name:                siphon-version:             0.2-synopsis:            Generic types and functions for columnar encoding and decoding+version:             0.6+synopsis:            Encode and decode CSV files description:         Please see README.md homepage:            https://github.com/andrewthad/colonnade#readme license:             BSD3@@ -26,7 +26,7 @@     Siphon.Internal.Text   build-depends:       base >= 4.7 && < 5-    , colonnade+    , colonnade >= 1.1 && < 1.2     , text     , bytestring     , contravariant@@ -53,6 +53,7 @@     , pipes     , HUnit     , test-framework-hunit+    , profunctors   ghc-options:         -threaded -rtsopts -with-rtsopts=-N   default-language:    Haskell2010
src/Siphon/Decoding.hs view
@@ -1,24 +1,38 @@-{-# LANGUAGE RankNTypes   #-}+{-# LANGUAGE RankNTypes #-} {-# LANGUAGE BangPatterns #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE DeriveFunctor #-} -module Siphon.Decoding where+module Siphon.Decoding +  ( mkParseError+  , headlessPipe+  , indexedPipe+  , headedPipe+  , consumeGeneral+  , pipeGeneral+  , convertDecodeError+  , headed+  , headless+  , indexed+  ) where  import Siphon.Types-import Colonnade.Types+import Colonnade (Headed(..),Headless(..)) import Siphon.Internal (row,comma) import Data.Text (Text) import Data.ByteString (ByteString) import Pipes (yield,Pipe,Consumer',Producer,await) import Data.Vector (Vector)+import Data.Functor.Contravariant (Contravariant(..))+import Data.Char (chr) import qualified Data.Vector as Vector-import qualified Colonnade.Decoding as Decoding import qualified Data.Attoparsec.ByteString as AttoByteString import qualified Data.ByteString.Char8 as ByteString import qualified Data.Attoparsec.Types as Atto -mkParseError :: Int -> [String] -> String -> DecodingRowError f content+mkParseError :: Int -> [String] -> String -> DecolonnadeRowError f content mkParseError i ctxs msg = id-  $ DecodingRowError i+  $ DecolonnadeRowError i   $ RowErrorParse $ concat     [ "Contexts: ["     , concat ctxs@@ -28,37 +42,37 @@     ]  -- | This is a convenience function for working with @pipes-text@.---   It will convert a UTF-8 decoding error into a `DecodingRowError`,+--   It will convert a UTF-8 decoding error into a `DecolonnadeRowError`, --   so the pipes can be properly chained together.-convertDecodeError :: String -> Either (Producer ByteString m ()) () -> Maybe (DecodingRowError f c)-convertDecodeError encodingName (Left _) = Just (DecodingRowError 0 (RowErrorMalformed encodingName))+convertDecodeError :: String -> Either (Producer ByteString m ()) () -> Maybe (DecolonnadeRowError f c)+convertDecodeError encodingName (Left _) = Just (DecolonnadeRowError 0 (RowErrorMalformed encodingName)) convertDecodeError _ (Right ()) = Nothing  -- | This is seldom useful but is included for completeness. headlessPipe :: Monad m   => Siphon c-  -> Decoding Headless c a-  -> Pipe c a m (DecodingRowError Headless c)+  -> Decolonnade Headless c a+  -> Pipe c a m (DecolonnadeRowError Headless c) headlessPipe sd decoding = uncheckedPipe requiredLength 0 sd indexedDecoding Nothing   where-  indexedDecoding = Decoding.headlessToIndexed decoding-  requiredLength = Decoding.length indexedDecoding+  indexedDecoding = headlessToIndexed decoding+  requiredLength = decLength indexedDecoding  indexedPipe :: Monad m   => Siphon c-  -> Decoding (Indexed Headless) c a-  -> Pipe c a m (DecodingRowError Headless c)+  -> Decolonnade (Indexed Headless) c a+  -> Pipe c a m (DecolonnadeRowError Headless c) indexedPipe sd decoding = do   e <- consumeGeneral 0 sd mkParseError   case e of     Left err -> return err     Right (firstRow, mleftovers) ->-      let req = Decoding.maxIndex decoding+      let req = maxIndex decoding           vlen = Vector.length firstRow        in if vlen < req-            then return (DecodingRowError 0 (RowErrorMinSize req vlen))-            else case Decoding.uncheckedRun decoding firstRow of-              Left cellErr -> return $ DecodingRowError 0 $ RowErrorDecode cellErr+            then return (DecolonnadeRowError 0 (RowErrorMinSize req vlen))+            else case uncheckedRun decoding firstRow of+              Left cellErr -> return $ DecolonnadeRowError 0 $ RowErrorDecode cellErr               Right a -> do                 yield a                 uncheckedPipe vlen 1 sd decoding mleftovers@@ -66,15 +80,15 @@  headedPipe :: (Monad m, Eq c)   => Siphon c-  -> Decoding Headed c a-  -> Pipe c a m (DecodingRowError Headed c)+  -> Decolonnade Headed c a+  -> Pipe c a m (DecolonnadeRowError Headed c) headedPipe sd decoding = do   e <- consumeGeneral 0 sd mkParseError   case e of     Left err -> return err     Right (headers, mleftovers) ->-      case Decoding.headedToIndexed headers decoding of-        Left headingErrs -> return (DecodingRowError 0 (RowErrorHeading headingErrs))+      case headedToIndexed headers decoding of+        Left headingErrs -> return (DecolonnadeRowError 0 (RowErrorHeading headingErrs))         Right indexedDecoding ->           let requiredLength = Vector.length headers            in uncheckedPipe requiredLength 1 sd indexedDecoding mleftovers@@ -84,18 +98,18 @@   => Int -- ^ expected length of each row   -> Int -- ^ index of first row, usually zero or one   -> Siphon c-  -> Decoding (Indexed f) c a+  -> Decolonnade (Indexed f) c a   -> Maybe c-  -> Pipe c a m (DecodingRowError f c)+  -> Pipe c a m (DecolonnadeRowError f c) uncheckedPipe requiredLength ix sd d mleftovers =   pipeGeneral ix sd mkParseError checkedRunWithRow mleftovers   where   checkedRunWithRow rowIx v =     let vlen = Vector.length v in     if vlen /= requiredLength-      then Left $ DecodingRowError rowIx+      then Left $ DecolonnadeRowError rowIx                 $ RowErrorSize requiredLength vlen-      else Decoding.uncheckedRunWithRow rowIx d v+      else uncheckedRunWithRow rowIx d v  consumeGeneral :: Monad m   => Int@@ -156,5 +170,170 @@   go = do     a <- await     if f a then go else return a++-- | Converts the content type of a 'Decolonnade'. The @'Contravariant' f@+-- constraint means that @f@ can be 'Headless' but not 'Headed'.+contramapContent :: forall c1 c2 f a. Contravariant f => (c2 -> c1) -> Decolonnade f c1 a -> Decolonnade f c2 a+contramapContent f = go+  where+  go :: forall b. Decolonnade f c1 b -> Decolonnade f c2 b+  go (DecolonnadePure x) = DecolonnadePure x+  go (DecolonnadeAp h decode apNext) =+    DecolonnadeAp (contramap f h) (decode . f) (go apNext)++headless :: (content -> Either String a) -> Decolonnade Headless content a+headless f = DecolonnadeAp Headless f (DecolonnadePure id)++headed :: content -> (content -> Either String a) -> Decolonnade Headed content a+headed h f = DecolonnadeAp (Headed h) f (DecolonnadePure id)++indexed :: Int -> (content -> Either String a) -> Decolonnade (Indexed Headless) content a+indexed ix f = DecolonnadeAp (Indexed ix Headless) f (DecolonnadePure id)++maxIndex :: forall f c a. Decolonnade (Indexed f) c a -> Int+maxIndex = go 0 where+  go :: forall b. Int -> Decolonnade (Indexed f) c b -> Int+  go !ix (DecolonnadePure _) = ix+  go !ix1 (DecolonnadeAp (Indexed ix2 _) decode apNext) =+    go (max ix1 ix2) apNext++-- | This function uses 'unsafeIndex' to access+--   elements of the 'Vector'.+uncheckedRunWithRow ::+     Int+  -> Decolonnade (Indexed f) content a+  -> Vector content+  -> Either (DecolonnadeRowError f content) a+uncheckedRunWithRow i d v = mapLeft (DecolonnadeRowError i . RowErrorDecode) (uncheckedRun d v)++-- | This function does not check to make sure that the indicies in+--   the 'Decolonnade' are in the 'Vector'.+uncheckedRun :: forall content a f.+                Decolonnade (Indexed f) content a+             -> Vector content+             -> Either (DecolonnadeCellErrors f content) a+uncheckedRun dc v = getEitherWrap (go dc)+  where+  go :: forall b.+        Decolonnade (Indexed f) content b+     -> EitherWrap (DecolonnadeCellErrors f content) b+  go (DecolonnadePure b) = EitherWrap (Right b)+  go (DecolonnadeAp ixed@(Indexed ix h) decode apNext) =+    let rnext = go apNext+        content = Vector.unsafeIndex v ix+        rcurrent = mapLeft (DecolonnadeCellErrors . Vector.singleton . DecolonnadeCellError content ixed) (decode content)+    in rnext <*> (EitherWrap rcurrent)++headlessToIndexed :: forall c a.+  Decolonnade Headless c a -> Decolonnade (Indexed Headless) c a+headlessToIndexed = go 0 where+  go :: forall b. Int -> Decolonnade Headless c b -> Decolonnade (Indexed Headless) c b+  go !ix (DecolonnadePure a) = DecolonnadePure a+  go !ix (DecolonnadeAp Headless decode apNext) =+    DecolonnadeAp (Indexed ix Headless) decode (go (ix + 1) apNext)++decLength :: forall f c a. Decolonnade f c a -> Int+decLength = go 0 where+  go :: forall b. Int -> Decolonnade f c b -> Int+  go !a (DecolonnadePure _) = a+  go !a (DecolonnadeAp _ _ apNext) = go (a + 1) apNext++-- | Maps over a 'Decolonnade' that expects headers, converting these+--   expected headers into the indices of the columns that they+--   correspond to.+headedToIndexed :: forall content a. Eq content+                => Vector content -- ^ Headers in the source document+                -> Decolonnade Headed content a -- ^ Decolonnade that contains expected headers+                -> Either (HeadingErrors content) (Decolonnade (Indexed Headed) content a)+headedToIndexed v = getEitherWrap . go+  where+  go :: forall b. Eq content+     => Decolonnade Headed content b+     -> EitherWrap (HeadingErrors content) (Decolonnade (Indexed Headed) content b)+  go (DecolonnadePure b) = EitherWrap (Right (DecolonnadePure b))+  go (DecolonnadeAp hd@(Headed h) decode apNext) =+    let rnext = go apNext+        ixs = Vector.elemIndices h v+        ixsLen = Vector.length ixs+        rcurrent+          | ixsLen == 1 = Right (Vector.unsafeIndex ixs 0)+          | ixsLen == 0 = Left (HeadingErrors (Vector.singleton h) Vector.empty)+          | otherwise   = Left (HeadingErrors Vector.empty (Vector.singleton (h,ixsLen)))+    in (\ix ap -> DecolonnadeAp (Indexed ix hd) decode ap)+       <$> EitherWrap rcurrent+       <*> rnext++-- | This adds one to the index because text editors consider+--   line number to be one-based, not zero-based.+prettyError :: (c -> String) -> DecolonnadeRowError f c -> String+prettyError toStr (DecolonnadeRowError ix e) = unlines+  $ ("Decolonnade error on line " ++ show (ix + 1) ++ " of file.")+  : ("Error Category: " ++ descr)+  : map ("  " ++) errDescrs+  where (descr,errDescrs) = prettyRowError toStr e++prettyRowError :: (content -> String) -> RowError f content -> (String, [String])+prettyRowError toStr x = case x of+  RowErrorParse err -> (,) "CSV Parsing"+    [ "The line could not be parsed into cells correctly."+    , "Original parser error: " ++ err+    ]+  RowErrorSize reqLen actualLen -> (,) "Row Length"+    [ "Expected the row to have exactly " ++ show reqLen ++ " cells."+    , "The row only has " ++ show actualLen ++ " cells."+    ]+  RowErrorMinSize reqLen actualLen -> (,) "Row Min Length"+    [ "Expected the row to have at least " ++ show reqLen ++ " cells."+    , "The row only has " ++ show actualLen ++ " cells."+    ]+  RowErrorMalformed enc -> (,) "Text Decolonnade"+    [ "Tried to decode the input as " ++ enc ++ " text"+    , "There is a mistake in the encoding of the text."+    ]+  RowErrorHeading errs -> (,) "Header" (prettyHeadingErrors toStr errs)+  RowErrorDecode errs -> (,) "Cell Decolonnade" (prettyCellErrors toStr errs)++prettyCellErrors :: (c -> String) -> DecolonnadeCellErrors f c -> [String]+prettyCellErrors toStr (DecolonnadeCellErrors errs) = drop 1 $+  flip concatMap errs $ \(DecolonnadeCellError content (Indexed ix _) msg) ->+    let str = toStr content in+    [ "-----------"+    , "Column " ++ columnNumToLetters ix+    , "Original parse error: " ++ msg+    , "Cell Content Length: " ++ show (Prelude.length str)+    , "Cell Content: " ++ if null str+        then "[empty cell]"+        else str+    ]++prettyHeadingErrors :: (c -> String) -> HeadingErrors c -> [String]+prettyHeadingErrors conv (HeadingErrors missing duplicates) = concat+  [ concatMap (\h -> ["The header " ++ conv h ++ " was missing."]) missing+  , concatMap (\(h,n) -> ["The header " ++ conv h ++ " occurred " ++ show n ++ " times."]) duplicates+  ]++columnNumToLetters :: Int -> String+columnNumToLetters i+  | i >= 0 && i < 25 = [chr (i + 65)]+  | otherwise = "Beyond Z. Fix this."+++newtype EitherWrap a b = EitherWrap+  { getEitherWrap :: Either a b+  } deriving (Functor)++instance Monoid a => Applicative (EitherWrap a) where+  pure = EitherWrap . Right+  EitherWrap (Left a1) <*> EitherWrap (Left a2) = EitherWrap (Left (mappend a1 a2))+  EitherWrap (Left a1) <*> EitherWrap (Right _) = EitherWrap (Left a1)+  EitherWrap (Right _) <*> EitherWrap (Left a2) = EitherWrap (Left a2)+  EitherWrap (Right f) <*> EitherWrap (Right b) = EitherWrap (Right (f b))++mapLeft :: (a -> b) -> Either a c -> Either b c+mapLeft _ (Right a) = Right a+mapLeft f (Left a) = Left (f a)+++
src/Siphon/Encoding.hs view
@@ -1,33 +1,28 @@ module Siphon.Encoding where  import Siphon.Types-import Colonnade.Types+import Colonnade (Colonnade,Headed) import Pipes (Pipe,yield) import qualified Pipes.Prelude as Pipes-import qualified Colonnade.Encoding as Encoding+import qualified Colonnade.Encode as E -row :: Siphon c-    -> Encoding f c a-    -> a-    -> c+row :: Siphon c -> Colonnade f a c -> a -> c row (Siphon escape intercalate _ _) e =-  intercalate . Encoding.runRow escape e+  intercalate . E.row escape e -header :: Siphon c-       -> Encoding Headed c a-       -> c+header :: Siphon c -> Colonnade Headed a c -> c header (Siphon escape intercalate _ _) e =-  intercalate (Encoding.runHeader escape e)+  intercalate (E.header escape e)  pipe :: Monad m   => Siphon c-  -> Encoding f c a+  -> Colonnade f a c   -> Pipe a c m x pipe siphon encoding = Pipes.map (row siphon encoding)  headedPipe :: Monad m   => Siphon c-  -> Encoding Headed c a+  -> Colonnade Headed a c   -> Pipe a c m x headedPipe siphon encoding = do   yield (header siphon encoding)
src/Siphon/Types.hs view
@@ -1,7 +1,13 @@+{-# LANGUAGE GADTs #-}+{-# LANGUAGE DeriveFunctor #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+ module Siphon.Types where  import Data.Vector (Vector)-import Colonnade.Types (DecodingRowError)+import Control.Exception (Exception)+import Data.Typeable (Typeable)+import qualified Data.Vector as Vector import qualified Data.Attoparsec.Types as Atto  newtype Escaped c = Escaped { getEscaped :: c }@@ -12,6 +18,77 @@   , siphonParseRow    :: c -> Atto.IResult c (Vector c)   , siphonNull        :: c -> Bool   }++data DecolonnadeCellError f content = DecolonnadeCellError+  { decodingCellErrorContent :: !content+  , decodingCellErrorHeader  :: !(Indexed f content)+  , decodingCellErrorMessage :: !String+  } deriving (Show,Read,Eq)++-- instance (Show (f content), Typeable content) => Exception (DecolonnadeError f content)++data Indexed f a = Indexed+  { indexedIndex :: !Int+  , indexedHeading :: !(f a)+  } deriving (Eq,Ord,Functor,Show,Read)++newtype DecolonnadeCellErrors f content = DecolonnadeCellErrors+  { getDecolonnadeCellErrors :: Vector (DecolonnadeCellError f content)+  } deriving (Monoid,Show,Read,Eq)++-- newtype ParseRowError = ParseRowError String++-- TODO: rewrite the instances for this by hand. They+-- currently use FlexibleContexts.+data DecolonnadeRowError f content = DecolonnadeRowError+  { decodingRowErrorRow   :: !Int+  , decodingRowErrorError :: !(RowError f content)+  } deriving (Show,Read,Eq)++-- TODO: rewrite the instances for this by hand. They+-- currently use FlexibleContexts.+data RowError f content+  = RowErrorParse !String -- ^ Error occurred parsing the document into cells+  | RowErrorDecode !(DecolonnadeCellErrors f content) -- ^ Error decoding the content+  | RowErrorSize !Int !Int -- ^ Wrong number of cells in the row+  | RowErrorHeading !(HeadingErrors content)+  | RowErrorMinSize !Int !Int+  | RowErrorMalformed !String -- ^ Error decoding unicode content+  deriving (Show,Read,Eq)++data HeadingErrors content = HeadingErrors+  { headingErrorsMissing   :: Vector content       -- ^ headers that were missing+  , headingErrorsDuplicate :: Vector (content,Int) -- ^ headers that occurred more than once+  } deriving (Show,Read,Eq)++instance (Show content, Typeable content) => Exception (HeadingErrors content)++instance Monoid (HeadingErrors content) where+  mempty = HeadingErrors Vector.empty Vector.empty+  mappend (HeadingErrors a1 b1) (HeadingErrors a2 b2) = HeadingErrors+    (a1 Vector.++ a2) (b1 Vector.++ b2)++-- | This just actually a specialization of the free applicative.+--   Check out @Control.Applicative.Free@ in the @free@ library to+--   learn more about this. The meanings of the fields are documented+--   slightly more in the source code. Unfortunately, haddock does not+--   play nicely with GADTs.+data Decolonnade f content a where+  DecolonnadePure :: !a -- function+               -> Decolonnade f content a+  DecolonnadeAp :: !(f content) -- header+             -> !(content -> Either String a) -- decoding function+             -> !(Decolonnade f content (a -> b)) -- next decoding+             -> Decolonnade f content b++instance Functor (Decolonnade f content) where+  fmap f (DecolonnadePure a) = DecolonnadePure (f a)+  fmap f (DecolonnadeAp h c apNext) = DecolonnadeAp h c ((f .) <$> apNext)++instance Applicative (Decolonnade f content) where+  pure = DecolonnadePure+  DecolonnadePure f <*> y = fmap f y+  DecolonnadeAp h c y <*> z = DecolonnadeAp h c (flip <$> y <*> z)  -- -- | This type is provided for convenience with @pipes-text@ -- data CsvResult f c
test/Test.hs view
@@ -12,26 +12,25 @@ import Data.Text                            (Text) import GHC.Generics                         (Generic) import Data.Either.Combinators-import Colonnade.Types import Siphon.Types import Data.Functor.Identity import Data.Functor.Contravariant           (contramap) import Data.Functor.Contravariant.Divisible (divided,conquered)+import Colonnade (headed,headless,Colonnade,Headed,Headless)+import Data.Profunctor (lmap) import qualified Data.Text                  as Text import qualified Data.ByteString.Builder    as Builder import qualified Data.ByteString.Lazy       as LByteString import qualified Data.ByteString            as ByteString import qualified Data.ByteString.Char8      as BC8-import qualified Colonnade.Decoding         as Decoding-import qualified Colonnade.Encoding         as Encoding-import qualified Colonnade.Decoding.ByteString.Char8 as CDB-import qualified Colonnade.Encoding.ByteString.Char8 as CEB-import qualified Colonnade.Decoding.Text    as CDT-import qualified Colonnade.Encoding.Text    as CET+import qualified Colonnade                  as Colonnade import qualified Siphon.Encoding            as SE import qualified Siphon.Decoding            as SD import qualified Siphon.Content             as SC import qualified Pipes.Prelude              as Pipes+import qualified Data.Text.Lazy as LText+import qualified Data.Text.Lazy.Builder as TBuilder+import qualified Data.Text.Lazy.Builder.Int as TBuilder import Pipes  main :: IO ()@@ -122,56 +121,56 @@ decodeFoo :: (c -> String) -> c -> Either String Foo decodeFoo f = fooFromString . f -decodingA :: Decoding Headless ByteString (Int,Char,Bool)+decodingA :: Decolonnade Headless ByteString (Int,Char,Bool) decodingA = (,,)-  <$> Decoding.headless CDB.int-  <*> Decoding.headless CDB.char-  <*> Decoding.headless CDB.bool+  <$> SD.headless dbInt+  <*> SD.headless dbChar+  <*> SD.headless dbBool -decodingB :: Decoding Headed ByteString (Int,Char,Bool)+decodingB :: Decolonnade Headed ByteString (Int,Char,Bool) decodingB = (,,)-  <$> Decoding.headed "number" CDB.int-  <*> Decoding.headed "letter" CDB.char-  <*> Decoding.headed "boolean" CDB.bool+  <$> SD.headed "number" dbInt+  <*> SD.headed "letter" dbChar+  <*> SD.headed "boolean" dbBool -encodingA :: Encoding Headless ByteString (Int,Char,Bool)-encodingA = contramap tripleToPairs-  $ divided (Encoding.headless CEB.int)-  $ divided (Encoding.headless CEB.char)-  $ divided (Encoding.headless CEB.bool)-  $ conquered+encodingA :: Colonnade Headless (Int,Char,Bool) ByteString+encodingA = mconcat+  [ lmap fst3 (headless ebInt)+  , lmap snd3 (headless ebChar)+  , lmap thd3 (headless ebBool)+  ] -encodingW :: Encoding Headless Text (Int,Char,Bool)-encodingW = contramap tripleToPairs-  $ divided (Encoding.headless CET.int)-  $ divided (Encoding.headless CET.char)-  $ divided (Encoding.headless CET.bool)-  $ conquered+encodingW :: Colonnade Headless (Int,Char,Bool) Text+encodingW = mconcat+  [ lmap fst3 (headless etInt)+  , lmap snd3 (headless etChar)+  , lmap thd3 (headless etBool)+  ] -encodingY :: Encoding Headless Text (Foo,Foo,Foo)-encodingY = contramap tripleToPairs-  $ divided (Encoding.headless $ encodeFoo Text.pack)-  $ divided (Encoding.headless $ encodeFoo Text.pack)-  $ divided (Encoding.headless $ encodeFoo Text.pack)-  $ conquered+encodingY :: Colonnade Headless (Foo,Foo,Foo) Text+encodingY = mconcat+  [ lmap fst3 (headless $ encodeFoo Text.pack)+  , lmap snd3 (headless $ encodeFoo Text.pack)+  , lmap thd3 (headless $ encodeFoo Text.pack)+  ] -decodingY :: Decoding Headless Text (Foo,Foo,Foo)+decodingY :: Decolonnade Headless Text (Foo,Foo,Foo) decodingY = (,,)-  <$> Decoding.headless (decodeFoo Text.unpack)-  <*> Decoding.headless (decodeFoo Text.unpack)-  <*> Decoding.headless (decodeFoo Text.unpack)+  <$> SD.headless (decodeFoo Text.unpack)+  <*> SD.headless (decodeFoo Text.unpack)+  <*> SD.headless (decodeFoo Text.unpack) -encodingB :: Encoding Headed ByteString (Int,Char,Bool)-encodingB = contramap tripleToPairs-  $ divided (Encoding.headed "number" CEB.int)-  $ divided (Encoding.headed "letter" CEB.char)-  $ divided (Encoding.headed "boolean" CEB.bool)-  $ conquered+encodingB :: Colonnade Headed (Int,Char,Bool) ByteString+encodingB = mconcat+  [ lmap fst3 (headed "number" ebInt)+  , lmap snd3 (headed "letter" ebChar)+  , lmap thd3 (headed "boolean" ebBool)+  ] -encodingC :: Encoding Headed ByteString (Int,Char,Bool)+encodingC :: Colonnade Headed (Int,Char,Bool) ByteString encodingC = mconcat-  [ contramap thd3 $ Encoding.headed "boolean" CEB.bool-  , contramap snd3 $ Encoding.headed "letter" CEB.char+  [ lmap thd3 $ headed "boolean" ebBool+  , lmap snd3 $ headed "letter" ebChar   ]  tripleToPairs :: (a,b,c) -> (a,(b,(c,())))@@ -182,8 +181,8 @@  runTestScenario :: (Monoid c, Eq c, Show c)   => Siphon c-  -> (Siphon c -> Encoding f c (Int,Char,Bool) -> Pipe (Int,Char,Bool) c Identity ())-  -> Encoding f c (Int,Char,Bool)+  -> (Siphon c -> Colonnade f (Int,Char,Bool) c -> Pipe (Int,Char,Bool) c Identity ())+  -> Colonnade f (Int,Char,Bool) c   -> c   -> Assertion runTestScenario s p e c =@@ -193,8 +192,8 @@  runCustomTestScenario :: (Monoid c, Eq c, Show c)   => Siphon c-  -> (Siphon c -> Encoding f c a -> Pipe a c Identity ())-  -> Encoding f c a+  -> (Siphon c -> Colonnade f a c -> Pipe a c Identity ())+  -> Colonnade f a c   -> a   -> c   -> Assertion@@ -224,4 +223,57 @@ -- | Take the third item out of a 3 element tuple thd3 :: (a,b,c) -> c thd3 (a,b,c) = c+++dbChar :: ByteString -> Either String Char+dbChar b = case BC8.length b of+  1 -> Right (BC8.head b)+  0 -> Left "cannot decode Char from empty bytestring"+  _ -> Left "cannot decode Char from multi-character bytestring"++dbInt :: ByteString -> Either String Int+dbInt b = do+  (a,bsRem) <- maybe (Left "could not parse int") Right (BC8.readInt b)+  if ByteString.null bsRem+    then Right a+    else Left "found extra characters after int"++dbBool :: ByteString -> Either String Bool+dbBool b+  | b == BC8.pack "true" = Right True+  | b == BC8.pack "false" = Right False+  | otherwise = Left "must be true or false"++ebChar :: Char -> ByteString+ebChar = BC8.singleton++ebInt :: Int -> ByteString+ebInt = LByteString.toStrict+    . Builder.toLazyByteString +    . Builder.intDec++ebBool :: Bool -> ByteString+ebBool x = case x of+  True -> BC8.pack "true"+  False -> BC8.pack "false"++ebByteString :: ByteString -> ByteString+ebByteString = id+++etChar :: Char -> Text+etChar = Text.singleton++etInt :: Int -> Text+etInt = LText.toStrict+    . TBuilder.toLazyText+    . TBuilder.decimal++etText :: Text -> Text+etText = id++etBool :: Bool -> Text+etBool x = case x of+  True -> Text.pack "true"+  False -> Text.pack "false"