packages feed

tickle (empty) → 0.0.1

raw patch · 10 files changed

+2560/−0 lines, 10 filesdep +QuickCheckdep +basedep +bifunctorsbuild-type:Customsetup-changed

Dependencies added: QuickCheck, base, bifunctors, bytestring, directory, doctest, filepath, lens, mtl, semigroupoids, semigroups, template-haskell, transformers, validation

Files

+ LICENSE view
@@ -0,0 +1,27 @@+Copyright 2014 Tony Morris++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions+are met:+1. Redistributions of source code must retain the above copyright+   notice, this list of conditions and the following disclaimer.+2. 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.+3. Neither the name of the author nor the names of his contributors+   may be used to endorse or promote products derived from this software+   without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE REGENTS 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 AUTHORS 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.
+ Setup.lhs view
@@ -0,0 +1,44 @@+#!/usr/bin/env runhaskell+\begin{code}+{-# OPTIONS_GHC -Wall #-}+module Main (main) where++import Data.List ( nub )+import Data.Version ( showVersion )+import Distribution.Package ( PackageName(PackageName), PackageId, InstalledPackageId, packageVersion, packageName )+import Distribution.PackageDescription ( PackageDescription(), TestSuite(..) )+import Distribution.Simple ( defaultMainWithHooks, UserHooks(..), simpleUserHooks )+import Distribution.Simple.Utils ( rewriteFile, createDirectoryIfMissingVerbose )+import Distribution.Simple.BuildPaths ( autogenModulesDir )+import Distribution.Simple.Setup ( BuildFlags(buildVerbosity), fromFlag )+import Distribution.Simple.LocalBuildInfo ( withLibLBI, withTestLBI, LocalBuildInfo(), ComponentLocalBuildInfo(componentPackageDeps) )+import Distribution.Verbosity ( Verbosity )+import System.FilePath ( (</>) )++main :: IO ()+main = defaultMainWithHooks simpleUserHooks+  { buildHook = \pkg lbi hooks flags -> do+     generateBuildModule (fromFlag (buildVerbosity flags)) pkg lbi+     buildHook simpleUserHooks pkg lbi hooks flags+  }++generateBuildModule :: Verbosity -> PackageDescription -> LocalBuildInfo -> IO ()+generateBuildModule verbosity pkg lbi = do+  let dir = autogenModulesDir lbi+  createDirectoryIfMissingVerbose verbosity True dir+  withLibLBI pkg lbi $ \_ libcfg -> do+    withTestLBI pkg lbi $ \suite suitecfg -> do+      rewriteFile (dir </> "Build_" ++ testName suite ++ ".hs") $ unlines+        [ "module Build_" ++ testName suite ++ " where"+        , "deps :: [String]"+        , "deps = " ++ (show $ formatdeps (testDeps libcfg suitecfg))+        ]+  where+    formatdeps = map (formatone . snd)+    formatone p = case packageName p of+      PackageName n -> n ++ "-" ++ showVersion (packageVersion p)++testDeps :: ComponentLocalBuildInfo -> ComponentLocalBuildInfo -> [(InstalledPackageId, PackageId)]+testDeps xs ys = nub $ componentPackageDeps xs ++ componentPackageDeps ys++\end{code}
+ changelog view
@@ -0,0 +1,4 @@+0.0.1++Initial release+
+ etc/ATTRIBUTIONS view
@@ -0,0 +1,36 @@+--------------------------------------------------------------------------------+binary+------++Copyright (c) Lennart Kolmodin++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions+are met:++1. Redistributions of source code must retain the above copyright+   notice, this list of conditions and the following disclaimer.++2. 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.++3. Neither the name of the author nor the names of his contributors+   may be used to endorse or promote products derived from this software+   without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE 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 AUTHORS 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.++--------------------------------------------------------------------------------
+ src/Data/Tickle.hs view
@@ -0,0 +1,9 @@+{-# LANGUAGE NoImplicitPrelude #-}++module Data.Tickle(+  module T+) where++import Data.Tickle.Get as T+import Data.Tickle.IsolateError as T+import Data.Tickle.RunGetResult as T
+ src/Data/Tickle/Get.hs view
@@ -0,0 +1,1743 @@+{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE CPP #-}+{-# LANGUAGE MagicHash #-}+{-# LANGUAGE Trustworthy #-}++#if defined(__GLASGOW_HASKELL__) && !defined(__HADDOCK__)+#include "MachDeps.h"+#endif++module Data.Tickle.Get(+  -- * Get data type+  Get+  -- ** Primitive parsers+, getLazyByteString+, getLazyByteStringNul+, getRemainingLazyByteString+, getPtr+, getWord8+, getWord16be+, getWord16le+, getWord32be+, getWord32le+, getWord64be+, getWord64le+, getWordhost+, getWord16host+, getWord32host +, getWord64host+, failGet+, constant+, bytesRead+, demandInput+, skip+, isNotEmpty+, isEmpty+, getByteString+, modify+, readN+, ensureN+  -- ** Higher-level combinators+, runAndKeepTrack+, pushBack+, pushFront+, xrunGetIncremental+, noMeansNo+, prompt+, isolate+, lookAhead+, lookAheadM+, lookAheadE+, readNWith+, calculateOffset+, pushChunk+, pushChunks+, pushEndOfInput+  -- ** Error label+, (!+)+, addLabel+, (!-)+, setLabel+, (!!-)+, modifyLabel+  -- * Decoder+, Decoder+, decoder+, _Fail+, _Partial+, _Done+  -- ** Run Get parser+, runGet+, runGetIncremental+  -- * XDecoder data type+, XDecoder+  -- ** Reduction+, xdecoder+  -- ** Prisms+, _XFail+, _XPartial+, _XDone+, _XBytesRead+  -- * CompletedXDecoder data type+, CompletedXDecoder+  -- ** Reduction+, completedXDecoder+  -- ** Prism+, _CompletedFail+, _CompletedDone+  -- ** Isomorphism+, completedIso+  -- ** Lens+, completedByteString+, completedValue+  -- ** Prism+, uncomplete+  -- ** Traversal+, uncompletedByteString+, uncompletedValue+) where++import Control.Applicative(Applicative((<*>), pure), (<$>))+import Control.Category(Category((.), id))+import Control.Lens.Iso(iso)+import Control.Lens.Lens(lens)+import Control.Lens.Prism(prism')+import Control.Lens.Review((#))+import Control.Lens.Type(Iso, Prism', Lens', Traversal')+import Control.Monad(Monad((>>=), (>>), return), ap)+import Data.Bifoldable(Bifoldable(bifoldMap))+import Data.Bifunctor(Bifunctor(bimap))+import Data.Bitraversable(Bitraversable(bitraverse))+import Data.Bits((.|.))+import Data.Bool(Bool(False, True), (&&), not)+import qualified Data.ByteString as B(ByteString, concat, append, length, splitAt, empty, null, break, drop)+import qualified Data.ByteString.Internal as BI+import qualified Data.ByteString.Lazy as L(ByteString, toChunks, fromChunks)+import qualified Data.ByteString.Lazy.Internal as LI(ByteString(Chunk, Empty))+import qualified Data.ByteString.Unsafe as BU(unsafeDrop, unsafeTake, unsafeHead, unsafeIndex, unsafeUseAsCString)+import Data.Either(Either(Left, Right), either)+import Data.Eq(Eq((==)))+import Data.Foldable(Foldable(foldMap))+import Data.Function(const)+import Data.Functor(Functor(fmap))+import Data.Functor.Apply(Apply((<.>)))+import Data.Functor.Alt(Alt((<!>)))+import qualified Data.Functor.Alt as Al(Alt(some, many))+import Data.Functor.Bind(Bind((>>-)))+import Data.Int(Int, Int64)+import Data.List(reverse)+import Data.Maybe(Maybe(Nothing, Just), maybe, isJust)+import Data.Monoid(Monoid(mempty))+import Data.Ord(Ord((>), (>=), (<), (>=)))+import Data.Semigroup(Semigroup((<>)))+import Data.Tickle.IsolateError(IsolateError, _NegativeSize, _IsolateXFail, _UnexpectedConsumed)+import Data.Tickle.RunGetResult(RunGetResult, _RunGet, _RunGetFail)+import Data.Traversable(Traversable(traverse))+import Data.Tuple(uncurry)+import Foreign(Ptr, castPtr, Storable(peek), sizeOf)+#if defined(__GLASGOW_HASKELL__) && !defined(__HADDOCK__)+import GHC.Word(Word, Word8, Word16(W16#), Word32(W32#), Word64(W64#))+import GHC.Base(uncheckedShiftL#, Int(I#))+#endif+import Prelude(Num((-), (+)), ($!), Show, fromIntegral, undefined)+import System.IO(IO)++-- $setup+-- >>> import Control.Lens.Fold((^?))+-- >>> import Control.Lens.Prism(_Right, _Left)+-- >>> import qualified Data.ByteString.Lazy.Char8 as BLC(pack)+-- >>> import qualified Data.ByteString.Char8 as BC(ByteString, pack)+-- >>> import Data.String(String)+-- >>> import Data.List((++))+-- >>> import Data.Maybe(fromMaybe, isNothing)+-- >>> import Data.Validation(_Success, _Failure)+-- >>> import Prelude(Num((*)), subtract, even, mod)++newtype Get e a = +  Get (forall r.+    B.ByteString ->+    (B.ByteString -> a -> XDecoder e r) ->+    XDecoder e r)++bimapG ::+  (e -> f)+  -> (a -> b)+  -> Get e a+  -> Get f b+bimapG f g (Get z) =+  Get (\b q -> +    let r = z b XDone+        go (XDone i a) = q i (g a)+        go (XPartial k) = XPartial (go . k)+        go (XFail i s) = XFail i (f s) +        go (XBytesRead u k) = XBytesRead u (go . k)+    in go r)+{-# INLINE bimapG #-}++-- | Map on the error and result of a @Get@ decoder.+--+-- >>> runGet (bimap (const True) (\x -> x + x) getWord8) (BLC.pack "")+-- RunGetFail 0 True+--+-- >>> runGet (bimap (const True) (\x -> x + x) getWord8) (BLC.pack "abc")+-- RunGet 194+instance Bifunctor Get where+  bimap =+    bimapG++fmapG ::+  (a -> b)+  -> Get e a+  -> Get e b+fmapG =+  bimapG id+{-# INLINE fmapG #-}++-- | Map on the result of a @Get@ decoder.+--+-- >>> runGet (fmap (\x -> x + x) getWord8) (BLC.pack "")+-- RunGetFail 0 ()+--+-- >>> runGet (fmap (\x -> x + x) getWord8) (BLC.pack "abc")+-- RunGet 194+instance Functor (Get e) where+  fmap =+    fmapG++-- | Apply a function on the @Get@ decoder result.+--+-- >>> runGet (fmap (+) getWord8 <.> getWord8) (BLC.pack "")+-- RunGetFail 0 ()+--+-- >>> runGet (fmap (+) getWord8 <.> getWord8) (BLC.pack "a")+-- RunGetFail 1 ()+--+-- >>> runGet (fmap (+) getWord8 <.> getWord8) (BLC.pack "ab")+-- RunGet 195+--+-- >>> runGet (fmap (+) getWord8 <.> getWord8) (BLC.pack "abc")+-- RunGet 195+instance Apply (Get e) where+  (<.>) =+    ap++apG ::+  Get e (a -> b)+  -> Get e a+  -> Get e b+apG d e =+  do b <- d+     a <- e+     return (b a)+{-# INLINE [0] apG #-}++-- | Apply a function on the @Get@ decoder result.+--+-- >>> runGet (fmap (+) getWord8 <*> getWord8) (BLC.pack "")+-- RunGetFail 0 ()+--+-- >>> runGet (fmap (+) getWord8 <*> getWord8) (BLC.pack "a")+-- RunGetFail 1 ()+--+-- >>> runGet (fmap (+) getWord8 <*> getWord8) (BLC.pack "ab")+-- RunGet 195+--+-- >>> runGet (fmap (+) getWord8 <*> getWord8) (BLC.pack "abc")+-- RunGet 195+--+-- >>> runGet (pure 7 :: Get () Int) (BLC.pack "abc")+-- RunGet 7+--+-- prop> runGet (pure x :: Get () Int) (BLC.pack "abc") == _RunGet # x+instance Applicative (Get e) where+  pure =+    return+  {-# INLINE pure #-}+  (<*>) =+    apG+  {-# INLINE (<*>) #-}++-- | Sequence an action through the @Get@ decoder.+--+-- >>> runGet (getWord8 >>- \c1 -> fmap (\c2 -> c1 + c2) getWord8) (BLC.pack "")+-- RunGetFail 0 ()+--+-- >>> runGet (getWord8 >>- \c1 -> fmap (\c2 -> c1 + c2) getWord8) (BLC.pack "a")+-- RunGetFail 1 ()+--+-- >>> runGet (getWord8 >>- \c1 -> fmap (\c2 -> c1 + c2) getWord8) (BLC.pack "ab")+-- RunGet 195+--+-- >>> runGet (getWord8 >>- \c1 -> fmap (\c2 -> c1 + c2) getWord8) (BLC.pack "abc")+-- RunGet 195+instance Bind (Get e) where+  (>>-) =+    (>>=)++returnG ::+  a+  -> Get e a+returnG a =+    Get (\b q -> q b a)+{-# INLINE [0] returnG #-}++bindG ::+  Get e a+  -> (a -> Get e b)+  -> Get e b+Get k `bindG` f =+  Get (\b q -> k b (\c a -> +    let Get l = f a +    in l c q))+{-# INLINE bindG #-}++-- | Sequence an action through the @Get@ decoder.+--+-- >>> runGet (return 7 :: Get () Int) (BLC.pack "abc")+-- RunGet 7+--+-- prop> runGet (return x :: Get () Int) (BLC.pack "abc") == _RunGet # x+--+-- >>> runGet (getWord8 >>= \c1 -> getWord8 >>= \c2 -> return (c1 + c2)) (BLC.pack "")+-- RunGetFail 0 ()+--+-- >>> runGet (getWord8 >>= \c1 -> getWord8 >>= \c2 -> return (c1 + c2)) (BLC.pack "a")+-- RunGetFail 1 ()+--+-- >>> runGet (getWord8 >>= \c1 -> getWord8 >>= \c2 -> return (c1 + c2)) (BLC.pack "ab")+-- RunGet 195+--+-- >>> runGet (getWord8 >>= \c1 -> getWord8 >>= \c2 -> return (c1 + c2)) (BLC.pack "abc")+-- RunGet 195+instance Monad (Get e) where+  return =+    returnG+  (>>=) =+    bindG++-- | Pick between two @Get@ decoders, finding the first to not fail.+--+-- >>> runGet ((+1) <$> getWord8 <!> subtract 1 <$> getWord8) (BLC.pack "")+-- RunGetFail 0 ()+--+-- >>> runGet ((+1) <$> getWord8 <!> subtract 1 <$> getWord8) (BLC.pack "abc")+-- RunGet 98+--+-- >>> runGet (getWord8 <!> failGet ()) (BLC.pack "")+-- RunGetFail 0 ()+--+-- >>> runGet (getWord8 <!> failGet ()) (BLC.pack "abc")+-- RunGet 97+--+-- >>> runGet (Al.some getWord8) (BLC.pack "")+-- RunGetFail 0 ()+--+-- >>> runGet (Al.some getWord8) (BLC.pack "a")+-- RunGet [97]+--+-- >>> runGet (Al.some getWord8) (BLC.pack "abc")+-- RunGet [97,98,99]+--+-- >>> runGet (Al.many getWord8) (BLC.pack "")+-- RunGet []+--+-- >>> runGet (Al.many getWord8) (BLC.pack "a")+-- RunGet [97]+--+-- >>> runGet (Al.many getWord8) (BLC.pack "abc")+-- RunGet [97,98,99]+instance Alt (Get e) where+  f <!> g = +    do (d, bs) <- runAndKeepTrack f+       case d of+         CompletedDone b a -> Get (\_ q -> q b a)+         CompletedFail _ _ -> pushBack bs >> g+  some p =+    (:) <$> p <*> Al.many p+  many p =+    (p >>= \x ->+     fmap (x:) (Al.many p)) <!> pure []+  +-- | Pick between two @Get@ decoders, finding the first to not fail.+--+-- >>> runGet (((+1) <$> getWord8) <> (subtract 1 <$> getWord8)) (BLC.pack "")+-- RunGetFail 0 ()+--+-- >>> runGet (((+1) <$> getWord8) <> (subtract 1 <$> getWord8)) (BLC.pack "abc")+-- RunGet 98+--+-- >>> runGet (getWord8 <> failGet ()) (BLC.pack "")+-- RunGetFail 0 ()+--+-- >>> runGet (getWord8 <> failGet ()) (BLC.pack "abc")+-- RunGet 97+instance Semigroup (Get e a) where+  (<>) =+    (<!>)++-- | A @Get@ decoder that always fails with the given value.+--+-- prop> runGet (failGet x :: Get Int ()) (BLC.pack s) == _RunGetFail # (0, x)+--+-- >>> runGet (failGet "abc" :: Get String ()) (BLC.pack "def")+-- RunGetFail 0 "abc"+failGet ::+  e+  -> Get e a+failGet e =+  Get (\i _ -> XFail i e)++constant ::+  (forall r. XDecoder e r)+  -> Get e a+constant d =+  Get (\_ _ -> d)++-- | Run a @Get@ decoder, but keep a track of the input that ran it to completion.+--+-- >>> runGet (runAndKeepTrack getWord8 :: Get () (CompletedXDecoder () Word8, [BC.ByteString])) (BLC.pack "")+-- RunGet (CompletedFail "" (),[])+--+-- >>> runGet (runAndKeepTrack getWord8 :: Get () (CompletedXDecoder () Word8, [BC.ByteString])) (BLC.pack "abc")+-- RunGet (CompletedDone "bc" 97,["abc"])+runAndKeepTrack ::+  Get e a+  -> Get x (CompletedXDecoder e a, [B.ByteString])+runAndKeepTrack (Get k) =+  Get (\b q -> +    let go !acc w = case w of+                      XDone c a -> q b (CompletedDone c a, reverse acc)+                      XPartial l -> XPartial (\c -> go (maybe acc (:acc) c) (l c))+                      XFail c e -> q b (CompletedFail c e, reverse acc)+                      XBytesRead i l -> XBytesRead i (go acc . l)+    in go [] (k b XDone))+{-# INLINE runAndKeepTrack #-}++-- |+--+-- >>> runGet (pushBack [] :: Get () ()) (BLC.pack "")+-- RunGet ()+--+-- >>> runGet (pushBack [] :: Get () ()) (BLC.pack "abc")+-- RunGet ()+--+-- >>> runGet (pushBack [BC.pack "def"] :: Get () ()) (BLC.pack "")+-- RunGet ()+--+-- >>> runGet (pushBack [BC.pack "def"] :: Get () ()) (BLC.pack "abc")+-- RunGet ()+pushBack ::+  [B.ByteString]+  -> Get e ()+pushBack z =+  let y [] = id+      y _ = B.concat . (:z)+  in Get (\b q -> q (y z b) ())+{-# INLINE pushBack #-}++-- |+--+-- >>> runGet (pushFront (BC.pack "def") :: Get () ()) (BLC.pack "")+-- RunGet ()+--+-- >>> runGet (pushFront (BC.pack "def") :: Get () ()) (BLC.pack "abc")+-- RunGet ()+pushFront ::+  B.ByteString+  -> Get e ()+pushFront b =+  Get (\c q -> q (B.append b c) ())+{-# INLINE pushFront #-}++xrunGetIncremental ::+  Get e a+  -> XDecoder e a+xrunGetIncremental (Get k) =+  noMeansNo (k B.empty XDone)++noMeansNo ::+  XDecoder e a+  -> XDecoder e a+noMeansNo = +  let neverAgain (XPartial k) =+        neverAgain (k Nothing)+      neverAgain (XBytesRead i k) =+        XBytesRead i (neverAgain . k)+      neverAgain r@(XDone _ _) =+        r+      neverAgain r@(XFail _ _) =+        r+      go (XPartial k) =+        XPartial (\b -> +          (if isJust b then go else neverAgain) (k b))+      go (XBytesRead i k) =+        XBytesRead i (go . k)+      go r@(XDone _ _) =+        r+      go r@(XFail _ _) =+        r+  in go++prompt ::+  B.ByteString+  -> XDecoder e a+  -> (B.ByteString -> XDecoder e a)+  -> XDecoder e a+prompt b d f =+  let loop = XPartial (maybe d (\s -> if B.null s then loop else f (b `B.append` s)))+  in loop++-- |+--+-- >>> runGet (bytesRead :: Get () Int64) (BLC.pack "")+-- RunGet 0+--+-- >>> runGet (bytesRead :: Get () Int64) (BLC.pack "abc")+-- RunGet 0+--+-- >>> runGet (getWord8 >> getWord16be >> getWord32le >> bytesRead) (BLC.pack "abcdefghijk")+-- RunGet 7+bytesRead ::+  Get e Int64+bytesRead =+  Get (\b q -> XBytesRead (fromIntegral (B.length b)) (q b))++-- |+--+-- >>> runGet (isolate 1 getWord8) (BLC.pack "ab")+-- RunGet 97+--+-- >>> runGet (isolate 1 getWord8) (BLC.pack "abcde")+-- RunGet 97+--+-- >>> runGet (isolate 2 getWord16le) (BLC.pack "abcde")+-- RunGet 25185+--+-- >>> runGet (isolate 1 getWord16le) (BLC.pack "abcde")+-- RunGetFail 0 (IsolateXFail ())+--+-- >>> runGet (isolate (-3) getWord16le) (BLC.pack "abcde")+-- RunGetFail 0 NegativeSize+--+-- >>> runGet (isolate 3 getWord16le) (BLC.pack "abcde")+-- RunGetFail 2 (UnexpectedConsumed 2 3)+isolate ::+  Int+  -> Get e a+  -> Get (IsolateError e) a+isolate m (Get k) =+  let go !n (XDone l x) =+        if n == 0 && B.null l+          then+            return x+          else+            do pushFront l+               failGet (_UnexpectedConsumed # (m - n - B.length l, m))+      go 0 (XPartial r) =+        go 0 (r Nothing)+      go n (XPartial r) =+        do i <- Get (\b q -> let takeLimited t =+                                   let (j, o) = B.splitAt n t+                                   in q o (Just j)+                             in if B.null b+                                  then+                                    prompt b (q B.empty Nothing) takeLimited+                                  else+                                    takeLimited b)+           case i of+             Nothing ->+               go n (r Nothing)+             Just u ->+               go (n - B.length u) (r (Just u))       +      go _ (XFail b e) =+        pushFront b >> failGet (_IsolateXFail # e)+      go n (XBytesRead i r) =+        go n (r $! fromIntegral m - fromIntegral n - i)+  in if m < 0+       then+         failGet (_NegativeSize # ())+       else+         go m (k B.empty XDone)++-- |+--+-- >>> runGet demandInput (BLC.pack "")+-- RunGetFail 0 ()+--+-- >>> runGet demandInput (BLC.pack "a")+-- RunGet ()+--+-- >>> runGet demandInput (BLC.pack "abc")+-- RunGet ()+demandInput ::+  Get () ()+demandInput =+  Get (\b q ->+    prompt b (XFail b ()) (`q` ()))++-- |+--+-- >>> runGet (getWord8 >>= \c -> skip 2 >> getWord8 >>= \d -> return (c,d)) (BLC.pack "")+-- RunGetFail 0 ()+--+-- >>> runGet (getWord8 >>= \c -> skip 2 >> getWord8 >>= \d -> return (c,d)) (BLC.pack "abcdefghi")+-- RunGet (97,100)+--+-- >>> runGet (getWord8 >>= \c -> skip 2 >> getWord8 >>= \d -> return (c,d)) (BLC.pack "abc")+-- RunGetFail 3 ()+skip ::+  Int+  -> Get () ()+skip n =+  readN n (return ())+{-# INLINE skip #-}++-- |+--+-- >>> runGet isNotEmpty (BLC.pack "")+-- RunGet False+--+-- >>> runGet isNotEmpty (BLC.pack "abc")+-- RunGet True+--+-- >>> runGet (isNotEmpty >>= \p -> getWord8 >>= \w -> return (w, p)) (BLC.pack "abc")+-- RunGet (97,True)+--+-- >>> runGet (isNotEmpty >>= \p -> getWord8 >>= \w -> return (w, p)) (BLC.pack "")+-- RunGetFail 0 ()+--+-- >>> runGet (isNotEmpty >>= \p -> getWord8 >>= \w -> return (w, p)) (BLC.pack "a")+-- RunGet (97,True)+isNotEmpty ::+  Get e Bool+isNotEmpty =+  fmap not isEmpty++-- |+--+-- >>> runGet isEmpty (BLC.pack "")+-- RunGet True+--+-- >>> runGet isEmpty (BLC.pack "abc")+-- RunGet False+--+-- >>> runGet (isEmpty >>= \p -> getWord8 >>= \w -> return (w, p)) (BLC.pack "abc")+-- RunGet (97,False)+--+-- >>> runGet (isEmpty >>= \p -> getWord8 >>= \w -> return (w, p)) (BLC.pack "")+-- RunGetFail 0 ()+--+-- >>> runGet (isEmpty >>= \p -> getWord8 >>= \w -> return (w, p)) (BLC.pack "a")+-- RunGet (97,False)+isEmpty ::+  Get e Bool+isEmpty =+  Get (\b q ->+    if B.null b+      then+        prompt b (q b True) (`q` False)+      else+        q b False)++-- |+--+-- >>> runGet (lookAhead getWord8) (BLC.pack "")+-- RunGetFail 0 ()+--+-- >>> runGet (lookAhead getWord8) (BLC.pack "abc")+-- RunGet 97+--+-- >>> runGet (lookAhead getWord8) (BLC.pack "a")+-- RunGet 97+lookAhead ::+  Get e a+  -> Get e a+lookAhead g =+  do (d, bs) <- runAndKeepTrack g+     case d of+       CompletedDone _ a ->+         pushBack bs >> return a+       CompletedFail inp s ->+         constant (XFail inp s)++-- |+--+-- >>> runGet (lookAheadM (getWord8 >>= \w -> return (if even w then Just (w + 5) else Nothing))) (BLC.pack "abc")+-- RunGet Nothing+--+-- >>> runGet (lookAheadM (getWord8 >>= \w -> return (if even w then Just (w + 5) else Nothing))) (BLC.pack "bc")+-- RunGet (Just 103)+--+-- >>> runGet (lookAheadM (getWord8 >>= \w -> return (if even w then Just (w + 5) else Nothing))) (BLC.pack "")+-- RunGetFail 0 ()+lookAheadM ::+  Get e (Maybe a)+  -> Get e (Maybe a)+lookAheadM g =+  let g' = fmap (maybe (Left ()) Right) g+  in fmap (either (return Nothing) Just) (lookAheadE g')++-- |+--+-- >>> runGet (lookAheadE (getWord8 >>= \w -> return (if even w then Left (w + 5) else Right (w - 4)))) (BLC.pack "abc")+-- RunGet (Right 93)+--+-- >>> runGet (lookAheadE (getWord8 >>= \w -> return (if even w then Left (w + 5) else Right (w - 4)))) (BLC.pack "bc")+-- RunGet (Left 103)+--+-- >>> runGet (lookAheadE (getWord8 >>= \w -> return (if even w then Left (w + 5) else Right (w - 4)))) (BLC.pack "")+-- RunGetFail 0 ()+lookAheadE ::+  Get e (Either a b)+  -> Get e (Either a b)+lookAheadE g =+  do (d, b) <- runAndKeepTrack g+     case d of+       CompletedDone _ (Left x) ->+         pushBack b >> return (Left x)+       CompletedDone i (Right x) ->+         Get (\_ q -> q i (Right x))+       CompletedFail i s ->+         constant (XFail i s)++-- |+--+-- >>> runGet ([(), ()] !+ (setLabel [] getWord8)) (BLC.pack "")+-- RunGetFail 0 [(),()]+--+-- >>> runGet ([(), ()] !+ (setLabel [] getWord8)) (BLC.pack "abc")+-- RunGet 97+(!+) ::+  Semigroup e =>+  e+  -> Get e a+  -> Get e a+(!+) =+  addLabel++infixl 3 !+++-- |+--+-- >>> runGet ([(), ()] `addLabel` (setLabel [] getWord8)) (BLC.pack "")+-- RunGetFail 0 [(),()]+--+-- >>> runGet ([(), ()] `addLabel` (setLabel [] getWord8)) (BLC.pack "abc")+-- RunGet 97+addLabel ::+  Semigroup e =>+  e+  -> Get e a+  -> Get e a+addLabel m =+  modifyLabel (<> m)++-- |+--+-- >>> runGet ("error" !- getWord8) (BLC.pack "")+-- RunGetFail 0 "error"+--+-- >>> runGet ("error" !- getWord8) (BLC.pack "abc")+-- RunGet 97+(!-) ::+  e+  -> Get d a+  -> Get e a+(!-) =+  setLabel++infixl 3 !-++-- |+--+-- >>> runGet ("error" `setLabel` getWord8) (BLC.pack "")+-- RunGetFail 0 "error"+--+-- >>> runGet ("error" `setLabel` getWord8) (BLC.pack "abc")+-- RunGet 97+setLabel ::+  e+  -> Get d a+  -> Get e a+setLabel =+  modifyLabel . return++-- |+--+-- >>> runGet (reverse !!- setLabel "error" getWord8) (BLC.pack "")+-- RunGetFail 0 "rorre"+--+-- >>> runGet (reverse !!- setLabel "error" getWord8) (BLC.pack "abc")+-- RunGet 97+(!!-) ::+  (d -> e)+  -> Get d a+  -> Get e a+(!!-) =+  modifyLabel++infixl 3 !!-++-- |+--+-- >>> runGet (reverse `modifyLabel` setLabel "error" getWord8) (BLC.pack "")+-- RunGetFail 0 "rorre"+--+-- >>> runGet (reverse `modifyLabel` setLabel "error" getWord8) (BLC.pack "abc")+-- RunGet 97+modifyLabel ::+  (d -> e)+  -> Get d a+  -> Get e a+modifyLabel m =+  bimap m id++-- |+--+-- >>> runGet (getByteString (-3)) (BLC.pack "")+-- RunGet ""+--+-- >>> runGet (getByteString 3) (BLC.pack "")+-- RunGetFail 0 ()+--+-- >>> runGet (getByteString 3) (BLC.pack "abc")+-- RunGet "abc"+--+-- >>> runGet (getByteString 3) (BLC.pack "abcdef")+-- RunGet "abc"+getByteString ::+  Int+  -> Get () B.ByteString+getByteString n =+  if n > 0+    then +      readN n (BU.unsafeTake n)+    else+      return B.empty+{-# INLINE getByteString #-}++modify ::+  (B.ByteString -> B.ByteString)+  -> Get e ()+modify f =+  Get (\b q -> q (f b) ())++get ::+  Get e B.ByteString+get =+  Get (\b q -> q b b)++put ::+  B.ByteString -> Get e ()+put s = +  Get (\_ q -> q s ())++-- |+--+-- >>> runGet (readN 3 id) (BLC.pack "abc")+-- RunGet "abc"+--+-- >>> runGet (readN 3 id) (BLC.pack "ab")+-- RunGetFail 0 ()+--+-- >>> runGet (readN 3 id) (BLC.pack "abcdef")+-- RunGet "abcdef"+--+-- >>> runGet (readN (-3) id) (BLC.pack "abcdef")+-- RunGet ""+readN ::+  Int+  -> (B.ByteString -> a)+  -> Get () a+readN !n f =+  ensureN n >> unsafeReadN n f+{-# INLINE [0] readN #-}++{-# RULES++"readN/readN merge" forall n m f g.+  readN n f `apG` readN m g =+    readN (n+m) (\bs -> f bs (g (BU.unsafeDrop n bs)))++"returnG/readN swap" [~1] forall f.+  returnG f =+    readN 0 (const f)++"readN 0/returnG swapback" [1] forall f.+  readN 0 f =+    returnG (f B.empty) ++  #-}++-- |+--+-- >>> runGet (ensureN 3) (BLC.pack "")+-- RunGetFail 0 ()+--+-- >>> runGet (ensureN 3) (BLC.pack "abc")+-- RunGet ()+--+-- >>> runGet (ensureN 3) (BLC.pack "abcdef")+-- RunGet ()+ensureN ::+  Int+  -> Get () ()+ensureN !m =+  Get (\i k -> +    let go n =+          Get (\b q -> if B.length b >= n+                         then+                           q b ()+                         else+                           let Get g = demandInput >> go n+                           in g b q)+    in if B.length i >= m+         then+           k i ()+         else+           let Get g = go m+           in g i k)+{-# INLINE ensureN #-}++unsafeReadN ::+  Int +  -> (B.ByteString -> a)+  -> Get e a+unsafeReadN !n f = +  Get (\b ks -> ks (BU.unsafeDrop n b) $! f b)++readNWith ::+  Int+  -> (Ptr a -> IO a)+  -> Get () a+readNWith n f =+  readN n (\s -> BI.inlinePerformIO (BU.unsafeUseAsCString s (f . castPtr)))+{-# INLINE readNWith #-}++data Decoder e a =+  Fail !B.ByteString {-# UNPACK #-} !Int64 e+  | Partial (Maybe B.ByteString -> Decoder e a)+  | Done !B.ByteString {-# UNPACK #-} !Int64 a++-- |+--+-- >>> decoder (\b i n -> B.length b + fromIntegral i + n) (\_ -> 99) (\b n a -> B.length b + fromIntegral n + a) (_Fail # (BC.pack "abc", 12, 19))+-- 34+--+-- >>> decoder (\b i n -> B.length b + fromIntegral i + n) (\_ -> 99) (\b n a -> B.length b + fromIntegral n + a) (_Partial # (\b -> _Fail # (fromMaybe (BC.pack "abc") b, 12, 19)))+-- 99+--+-- >>> decoder (\b i n -> B.length b + fromIntegral i + n) (\_ -> 99) (\b n a -> B.length b + fromIntegral n + a) (_Done # (BC.pack "abc", 12, 19))+-- 34+decoder :: +  (B.ByteString -> Int64 -> e -> x)+  -> ((Maybe B.ByteString -> Decoder e a) -> x)+  -> (B.ByteString -> Int64 -> a -> x)+  -> Decoder e a+  -> x+decoder f _ _ (Fail b i e) =+  f b i e+decoder _ p _ (Partial k) =+  p k+decoder _ _ d (Done b i a) =+  d b i a++-- |+--+-- >>> (_Fail # (BC.pack "abc", 19, 31)) ^? _Fail+-- Just ("abc",19,31)+--+-- >>> isNothing ((_Fail # (BC.pack "abc", 19, 31)) ^? _Partial)+-- True+--+-- >>> (_Fail # (BC.pack "abc", 19, 31)) ^? _Done+-- Nothing+_Fail ::+  Prism' (Decoder e a) (B.ByteString, Int64, e)+_Fail =+  prism'+    (\(b, i, e) -> Fail b i e)+    (\x -> case x of+             Fail b i e -> Just (b, i, e)+             _ -> Nothing)++-- |+--+-- >>> (_Partial # (\b -> _Fail # (fromMaybe (BC.pack "abc") b, 12, 19))) ^? _Fail+-- Nothing+--+-- >>> isJust ((_Partial # (\b -> _Fail # (fromMaybe (BC.pack "abc") b, 12, 19))) ^? _Partial)+-- True+--+-- >>> (_Partial # (\b -> _Fail # (fromMaybe (BC.pack "abc") b, 12, 19))) ^? _Done+-- Nothing+_Partial ::+  Prism' (Decoder e a) (Maybe B.ByteString -> Decoder e a)+_Partial =+  prism'+    Partial+    (\x -> case x of+             Partial k -> Just k+             _ -> Nothing)++-- |+--+-- >>> (_Done # (BC.pack "abc", 19, 31)) ^? _Fail+-- Nothing+--+-- >>> isNothing ((_Done # (BC.pack "abc", 19, 31)) ^? _Partial)+-- True+--+-- >>> (_Done # (BC.pack "abc", 19, 31)) ^? _Done+-- Just ("abc",19,31)+_Done ::+  Prism' (Decoder e a) (B.ByteString, Int64, a)+_Done =+  prism'+    (\(b, i, a) -> Done b i a)+    (\x -> case x of+             Done b i a -> Just (b, i, a)+             _ -> Nothing)++bimapD ::+  (e -> f)+  -> (a -> b)+  -> Decoder e a+  -> Decoder f b+bimapD f _ (Fail b i e) =+  Fail b i (f e)+bimapD f g (Partial k) =+  Partial (bimapD f g . k)+bimapD _ g (Done b i a) =+  Done b i (g a)+{-# INLINE bimapD #-}++-- |+--+-- >>> (bimap (+10) (*20) (_Fail # (BC.pack "abc", 19, 31))) ^? _Fail+-- Just ("abc",19,41)+--+-- >>> (bimap (+10) (*20) (_Done # (BC.pack "abc", 19, 31))) ^? _Done+-- Just ("abc",19,620)+instance Bifunctor Decoder where+  bimap =+    bimapD++fmapD ::+  (a -> b)+  -> Decoder e a+  -> Decoder e b+fmapD =+  bimapD id+{-# INLINE fmapD #-}++-- |+--+-- >>> (fmap (+10) (_Fail # (BC.pack "abc", 19, 31))) ^? _Fail+-- Just ("abc",19,31)+--+-- >>> (fmap (+10) (_Done # (BC.pack "abc", 19, 31))) ^? _Done+-- Just ("abc",19,41)+instance Functor (Decoder e) where+  fmap =+    fmapD++calculateOffset :: +  XDecoder e a+  -> Decoder e a+calculateOffset s =+  let go r !acc =+        case r of+          XDone i a ->+            Done i (acc - fromIntegral (B.length i)) a+          XFail i e ->+            Fail i (acc - fromIntegral (B.length i)) e+          XPartial k ->+            Partial (\b ->+              case b of+                Nothing -> go (k Nothing) acc+                Just j -> go (k b) (acc + fromIntegral (B.length j)))+          XBytesRead i k ->+            go (k $! (acc - i)) acc+  in go s 0++runGetIncremental ::+  Get e a+  -> Decoder e a+runGetIncremental =+  calculateOffset . xrunGetIncremental++takeHeadChunk ::+  L.ByteString+  -> Maybe B.ByteString+takeHeadChunk lbs =+  case lbs of+    (LI.Chunk bs _) ->+      Just bs+    _ ->+      Nothing++dropHeadChunk ::+  L.ByteString+  -> L.ByteString+dropHeadChunk lbs =+  case lbs of+    (LI.Chunk _ lbs') ->+      lbs'+    _ ->+      LI.Empty++runGet ::+  Get e a+  -> L.ByteString+  -> RunGetResult e a+runGet g b =+  let feedAll (Done _ _ x) _ =+        _RunGet # x+      feedAll (Partial k) c =+        feedAll (k (takeHeadChunk c)) (dropHeadChunk c)+      feedAll (Fail _ p e) _ =+        _RunGetFail # (p, e)+  in feedAll (runGetIncremental g) b+    +pushChunk ::+  Decoder e a+  -> B.ByteString+  -> Decoder e a+pushChunk r i =+  case r of+    Done j p a ->+      Done (j `B.append` i) p a+    Partial k ->+      k (Just i)+    Fail j p s ->+      Fail (j `B.append` i) p s++pushChunks ::+  Decoder e a+  -> L.ByteString+  -> Decoder e a+pushChunks r0 =+  let go r [] =+        r+      go (Done i p a) xs =+        Done (B.concat (i:xs)) p a+      go (Fail i p s) xs =+        Fail (B.concat (i:xs)) p s+      go (Partial k) (x:xs) =+        go (k (Just x)) xs+  in go r0 . L.toChunks+    +pushEndOfInput ::+  Decoder e a+  -> Decoder e a+pushEndOfInput r =+  case r of+    Done {} -> r+    Partial k -> k Nothing+    Fail {} -> r++-- |+--+-- >>> runGet (getLazyByteString 5) (BLC.pack "")+-- RunGetFail 0 ()+--+-- >>> runGet (getLazyByteString 5) (BLC.pack "abc")+-- RunGetFail 3 ()+--+-- >>> runGet (getLazyByteString 5) (BLC.pack "abcdefg")+-- RunGet "abcde"+getLazyByteString ::+  Int64+  -> Get () L.ByteString+getLazyByteString =+  let consume n s =+        if fromIntegral (B.length s) >= n+          then+            Right (B.splitAt (fromIntegral n) s)+          else+            Left (fromIntegral (B.length s))+      go n =+        do s <- get+           case consume n s of+             Left u ->+               do put B.empty+                  demandInput+                  fmap (s:) (go (n - u))+             Right (w, r) ->+               do put r+                  return [w]+  in fmap L.fromChunks . go++-- |+--+-- >>> runGet getLazyByteStringNul (BLC.pack "")+-- RunGetFail 0 ()+--+-- >>> runGet getLazyByteStringNul (BLC.pack "abc")+-- RunGetFail 3 ()+--+-- >>> runGet getLazyByteStringNul (BLC.pack "abc\0")+-- RunGet "abc"+--+-- >>> runGet getLazyByteStringNul (BLC.pack "abc\0def")+-- RunGet "abc"+getLazyByteStringNul ::+  Get () L.ByteString+getLazyByteStringNul =+  let findNull s =+        case B.break (==0) s of+          (w, r) ->+            if B.null r +              then+                Nothing+              else+                Just (w, B.drop 1 r)+      go =+        do s <- get +           case findNull s of+             Nothing ->+               do put B.empty+                  demandInput+                  fmap (s:) go+             Just (w, r) -> +               do put r+                  return [w]+  in fmap L.fromChunks go++-- |+--+-- >>> runGet getRemainingLazyByteString  (BLC.pack "")+-- RunGet ""+--+-- >>> runGet getRemainingLazyByteString  (BLC.pack "abc")+-- RunGet "abc"+getRemainingLazyByteString ::+  Get e L.ByteString+getRemainingLazyByteString =+  let go =+        do s <- get+           put B.empty+           d <- isEmpty+           if d+             then +               return [s]+             else+               fmap (s:) go+  in fmap L.fromChunks go++getPtr ::+  Storable a =>+  Int+  -> Get () a+getPtr n =+  readNWith n peek+{-# INLINE getPtr #-}++{-# RULES++"getWord8/readN" getWord8 =+  readN 1 BU.unsafeHead+  +"getWord16be/readN" getWord16be =+  readN 2 word16be++"getWord16le/readN" getWord16le =+  readN 2 word16le++"getWord32be/readN" getWord32be =+  readN 4 word32be++"getWord32le/readN" getWord32le =+  readN 4 word32le++"getWord64be/readN" getWord64be =+  readN 8 word64be++"getWord64le/readN" getWord64le =+  readN 8 word64le++  #-}++-- |+--+-- >>> runGet getWord8 (BLC.pack "abc")+-- RunGet 97+--+-- >>> runGet getWord8 (BLC.pack "123")+-- RunGet 49+getWord8 ::+  Get () Word8+getWord8 =+  readN 1 BU.unsafeHead+{-# INLINE [0] getWord8 #-}++word16be ::+  B.ByteString+  -> Word16+word16be s =+    (fromIntegral (s `BU.unsafeIndex` 0) `shiftlW16` 8) .|.+    fromIntegral (s `BU.unsafeIndex` 1)+{-# INLINE word16be #-}++-- |+--+-- >>> runGet getWord16be (BLC.pack "abc")+-- RunGet 24930+--+-- >>> runGet getWord16be (BLC.pack "123")+-- RunGet 12594+getWord16be ::+  Get () Word16+getWord16be =+  readN 2 word16be+{-# INLINE [0] getWord16be #-}++word16le ::+  B.ByteString+  -> Word16+word16le s =+    (fromIntegral (s `BU.unsafeIndex` 1) `shiftlW16` 8) .|.+    fromIntegral (s `BU.unsafeIndex` 0)+{-# INLINE word16le #-}++-- |+--+-- >>> runGet getWord16le (BLC.pack "abc")+-- RunGet 25185+--+-- >>> runGet getWord16le (BLC.pack "123")+-- RunGet 12849+getWord16le ::+  Get () Word16+getWord16le =+  readN 2 word16le+{-# INLINE [0] getWord16le #-}++word32be ::+  B.ByteString+  -> Word32+word32be s =+    (fromIntegral (s `BU.unsafeIndex` 0) `shiftlW32` 24) .|.+    (fromIntegral (s `BU.unsafeIndex` 1) `shiftlW32` 16) .|.+    (fromIntegral (s `BU.unsafeIndex` 2) `shiftlW32`  8) .|.+    fromIntegral (s `BU.unsafeIndex` 3)+{-# INLINE word32be #-}++-- |+--+-- >>> runGet getWord32be (BLC.pack "abcdef")+-- RunGet 1633837924+--+-- >>> runGet getWord32be (BLC.pack "123456")+-- RunGet 825373492+getWord32be ::+  Get () Word32+getWord32be =+  readN 4 word32be+{-# INLINE [0] getWord32be #-}++word32le ::+  B.ByteString+  -> Word32+word32le s =+    (fromIntegral (s `BU.unsafeIndex` 3) `shiftlW32` 24) .|.+    (fromIntegral (s `BU.unsafeIndex` 2) `shiftlW32` 16) .|.+    (fromIntegral (s `BU.unsafeIndex` 1) `shiftlW32`  8) .|.+    fromIntegral (s `BU.unsafeIndex` 0)+{-# INLINE word32le #-}++-- |+--+-- -- >>> runGet getWord32le (BLC.pack "abcdef")+-- RunGet 1684234849+--+-- >>> runGet getWord32le (BLC.pack "123456")+-- RunGet 875770417+getWord32le ::+  Get () Word32+getWord32le =+  readN 4 word32le+{-# INLINE [0] getWord32le #-}++word64be ::+  B.ByteString+  -> Word64+word64be s =+    (fromIntegral (s `BU.unsafeIndex` 0) `shiftlW64` 56) .|.+    (fromIntegral (s `BU.unsafeIndex` 1) `shiftlW64` 48) .|.+    (fromIntegral (s `BU.unsafeIndex` 2) `shiftlW64` 40) .|.+    (fromIntegral (s `BU.unsafeIndex` 3) `shiftlW64` 32) .|.+    (fromIntegral (s `BU.unsafeIndex` 4) `shiftlW64` 24) .|.+    (fromIntegral (s `BU.unsafeIndex` 5) `shiftlW64` 16) .|.+    (fromIntegral (s `BU.unsafeIndex` 6) `shiftlW64`  8) .|.+    fromIntegral (s `BU.unsafeIndex` 7)+{-# INLINE word64be #-}++-- |+--+-- >>> runGet getWord64be (BLC.pack "abcdefghi")+-- RunGet 7017280452245743464+--+-- >>> runGet getWord64be (BLC.pack "123456789")+-- RunGet 3544952156018063160+getWord64be ::+  Get () Word64+getWord64be =+  readN 8 word64be+{-# INLINE [0] getWord64be #-}++word64le ::+  B.ByteString+  -> Word64+word64le s =+    (fromIntegral (s `BU.unsafeIndex` 7) `shiftlW64` 56) .|.+    (fromIntegral (s `BU.unsafeIndex` 6) `shiftlW64` 48) .|.+    (fromIntegral (s `BU.unsafeIndex` 5) `shiftlW64` 40) .|.+    (fromIntegral (s `BU.unsafeIndex` 4) `shiftlW64` 32) .|.+    (fromIntegral (s `BU.unsafeIndex` 3) `shiftlW64` 24) .|.+    (fromIntegral (s `BU.unsafeIndex` 2) `shiftlW64` 16) .|.+    (fromIntegral (s `BU.unsafeIndex` 1) `shiftlW64`  8) .|.+    fromIntegral (s `BU.unsafeIndex` 0) +{-# INLINE word64le #-}++-- |+--+-- >>> runGet getWord64le (BLC.pack "abcdefghi")+-- RunGet 7523094288207667809+--+-- >>> runGet getWord64le (BLC.pack "123456789")+-- RunGet 4050765991979987505+getWord64le ::+  Get () Word64+getWord64le =+  readN 8 word64le+{-# INLINE [0] getWord64le #-}++-- |+--+-- >>> runGet getWordhost (BLC.pack "abcdefghi")+-- RunGet 7523094288207667809+--+-- >>> runGet getWordhost (BLC.pack "123456789")+-- RunGet 4050765991979987505+getWordhost ::+  Get () Word+getWordhost =+  getPtr (sizeOf (undefined :: Word))+{-# INLINE getWordhost #-}++-- |+--+-- >>> runGet getWord16host (BLC.pack "abcde")+-- RunGet 25185+--+-- >>> runGet getWord16host (BLC.pack "12345")+-- RunGet 12849+getWord16host ::+  Get () Word16+getWord16host =+  getPtr (sizeOf (undefined :: Word16))+{-# INLINE getWord16host #-}++-- |+--+-- >>> runGet getWord32host (BLC.pack "abcde")+-- RunGet 1684234849+--+-- >>> runGet getWord32host (BLC.pack "12345")+-- RunGet 875770417+getWord32host ::+  Get () Word32+getWord32host =+  getPtr (sizeOf (undefined :: Word32))+{-# INLINE getWord32host #-}++-- |+--+-- >>> runGet getWord64host (BLC.pack "abcdeghi")+-- RunGet 7595434456733934177+--+-- >>> runGet getWord64host (BLC.pack "123456789")+-- RunGet 4050765991979987505+getWord64host ::+  Get () Word64+getWord64host =+  getPtr (sizeOf (undefined :: Word64))+{-# INLINE getWord64host #-}++------------------------------------------------------------------------+-- Unchecked shifts++shiftlW16 ::+  Word16+  -> Int+  -> Word16+shiftlW32 ::+  Word32+  -> Int+  -> Word32+shiftlW64 ::+  Word64+  -> Int+  -> Word64++#if defined(__GLASGOW_HASKELL__) && !defined(__HADDOCK__)+shiftlW16 (W16# w) (I# i) =+  W16# (w `uncheckedShiftL#`   i)+shiftlW32 (W32# w) (I# i) =+  W32# (w `uncheckedShiftL#`   i)++#if WORD_SIZE_IN_BITS < 64+shiftlW64 (W64# w) (I# i) =+  W64# (w `uncheckedShiftL64#` i)++#if __GLASGOW_HASKELL__ <= 606+-- Exported by GHC.Word in GHC 6.8 and higher+foreign import ccall unsafe "stg_uncheckedShiftL64"+  uncheckedShiftL64# ::+    Word64#+    -> Int#+    -> Word64#+#endif++#else+shiftlW64 (W64# w) (I# i) =+  W64# (w `uncheckedShiftL#` i)+#endif++#else+shiftlW16 =+  shiftL+shiftlW32 =+  shiftL+shiftlW64 =+  shiftL+#endif++----++data XDecoder e a =+  XFail !B.ByteString e+  | XPartial (Maybe B.ByteString -> XDecoder e a)+  | XDone !B.ByteString a+  | XBytesRead {-# UNPACK #-} !Int64 (Int64 -> XDecoder e a)++xdecoder :: +  (B.ByteString -> e -> x)+  -> ((Maybe B.ByteString -> XDecoder e a) -> x)+  -> (B.ByteString -> a -> x)+  -> (Int64 -> (Int64 -> XDecoder e a) -> x)+  -> XDecoder e a+  -> x+xdecoder f _ _ _ (XFail b e) =+  f b e+xdecoder _ p _ _ (XPartial k) =+  p k+xdecoder _ _ d _ (XDone b a) =+  d b a+xdecoder _ _ _ r (XBytesRead i k) =+  r i k++_XFail ::+  Prism' (XDecoder e a) (B.ByteString, e)+_XFail =+  prism'+    (uncurry XFail)+    (\x -> case x of+             XFail b e -> Just (b, e)+             _ -> Nothing)++_XPartial ::+  Prism' (XDecoder e a) (Maybe B.ByteString -> XDecoder e a)+_XPartial =+  prism'+    XPartial+    (\x -> case x of+             XPartial k -> Just k+             _ -> Nothing)++_XDone ::+  Prism' (XDecoder e a) (B.ByteString, a)+_XDone =+  prism'+    (uncurry XDone)+    (\x -> case x of+             XDone b a -> Just (b, a)+             _ -> Nothing)+_XBytesRead ::+  Prism' (XDecoder e a) (Int64, Int64 -> XDecoder e a)+_XBytesRead =+  prism'+    (uncurry XBytesRead)+    (\x -> case x of+             XBytesRead i k -> Just (i, k)+             _ -> Nothing)++{-# INLINE _XFail #-}+{-# INLINE _XPartial #-}+{-# INLINE _XDone #-}+{-# INLINE _XBytesRead #-}++instance Functor (XDecoder e) where+  fmap =+    bimap id++instance Bifunctor XDecoder where+  bimap f _ (XFail b e) =+    XFail b (f e)+  bimap f g (XPartial k) =+    XPartial (bimap f g . k)+  bimap _ g (XDone b a) =+    XDone b (g a)+  bimap f g (XBytesRead i k) =+    XBytesRead i (bimap f g . k)+    +instance Bifoldable XDecoder where+  bifoldMap f _ (XFail _ e) =+    f e+  bifoldMap _ _ (XPartial _) =+    mempty+  bifoldMap _ g (XDone _ a) =+    g a+  bifoldMap _ _ (XBytesRead _ _) =+    mempty++instance Foldable (XDecoder e) where+  foldMap _ (XFail _ _) =+    mempty+  foldMap _ (XPartial _) =+    mempty+  foldMap f (XDone _ a) =+    f a+  foldMap _ (XBytesRead _ _) =+    mempty++data CompletedXDecoder e a =+  CompletedFail !B.ByteString e+  | CompletedDone !B.ByteString a+  deriving (Eq, Ord, Show)++completedXDecoder ::+  (B.ByteString -> e -> x)+  -> (B.ByteString -> a -> x)+  -> CompletedXDecoder e a+  -> x+completedXDecoder f _ (CompletedFail b e) =+  f b e+completedXDecoder _ d (CompletedDone b a) =+  d b a++_CompletedFail ::+  Prism' (CompletedXDecoder e a) (B.ByteString, e)+_CompletedFail =+  prism'+    (uncurry CompletedFail)+    (\x -> case x of+             CompletedFail b e -> Just (b, e)+             _ -> Nothing)++_CompletedDone ::+  Prism' (CompletedXDecoder e a) (B.ByteString, a)+_CompletedDone =+  prism'+    (uncurry CompletedDone)+    (\x -> case x of+             CompletedDone b a -> Just (b, a)+             _ -> Nothing)++completedIso ::+  Iso (CompletedXDecoder e a) (CompletedXDecoder f b) (Either e a, B.ByteString) (Either f b, B.ByteString)+completedIso =+  iso+    (\d -> case d of+             CompletedFail b e -> (Left e, b)+             CompletedDone b a -> (Right a, b))+    (\z -> case z of+             (Left e, b) -> CompletedFail b e+             (Right a, b) -> CompletedDone b a)+{-# INLINE completedIso #-}++completedByteString ::+  Lens' (CompletedXDecoder e a) B.ByteString+completedByteString =+  lens+    (\d -> case d of+             CompletedFail b _ -> b+             CompletedDone b _ -> b)+    (\d b -> case d of+               CompletedFail _ e -> CompletedFail b e+               CompletedDone _ a -> CompletedDone b a)+{-# INLINE completedByteString #-}++completedValue ::+  Lens' (CompletedXDecoder e a) (Either e a)+completedValue =+  lens+    (\d -> case d of+             CompletedFail _ e -> Left e+             CompletedDone _ a -> Right a)+    (\d z -> case d of+               CompletedFail b e -> CompletedFail b (either id (pure e) z)+               CompletedDone b a -> CompletedDone b (either (pure a) id z))+{-# INLINE completedValue #-}++instance Functor (CompletedXDecoder e) where+  fmap =+    bimap id++instance Bifunctor CompletedXDecoder where+  bimap f _ (CompletedFail b e) =+    CompletedFail b (f e)+  bimap _ g (CompletedDone b a) =+    CompletedDone b (g a)++instance Foldable (CompletedXDecoder e) where+  foldMap _ (CompletedFail _ _) =+    mempty+  foldMap f (CompletedDone _ a) =+    f a++instance Traversable (CompletedXDecoder e) where+  traverse = +    bitraverse pure++instance Bifoldable CompletedXDecoder where+  bifoldMap f _ (CompletedFail _ e) = +    f e+  bifoldMap _ g (CompletedDone _ a) =+    g a++instance Bitraversable CompletedXDecoder where+  bitraverse f _ (CompletedFail b e) =+    fmap (CompletedFail b) (f e)+  bitraverse _ g (CompletedDone b a) =+    fmap (CompletedDone b) (g a)++uncomplete ::+  Prism' (XDecoder e a) (CompletedXDecoder e a)+uncomplete =+  prism'+    (\d -> case d of+             CompletedFail b e -> XFail b e+             CompletedDone b a -> XDone b a)+    (\d -> case d of+             XFail b e -> Just (CompletedFail b e)+             XPartial _ -> Nothing+             XDone b a -> Just (CompletedDone b a)+             XBytesRead _ _ -> Nothing)+{-# INLINE uncomplete #-}++uncompletedByteString ::+  Traversal' (XDecoder e a) B.ByteString+uncompletedByteString = +  uncomplete . completedByteString+{-# INLINE uncompletedByteString #-}++uncompletedValue ::+  Traversal' (XDecoder e a) (Either e a)+uncompletedValue = +  uncomplete . completedValue+{-# INLINE uncompletedValue #-}
+ src/Data/Tickle/IsolateError.hs view
@@ -0,0 +1,168 @@+{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE Safe #-}++module Data.Tickle.IsolateError(+  -- * Data type+  IsolateError+  -- * Reduction+, isolateError+  -- * Prisms+, _NegativeSize+, _IsolateXFail+, _UnexpectedConsumed+) where++import Control.Lens.Prism(prism')+import Control.Lens.Type(Prism')+import Data.Eq(Eq)+import Data.Function(const)+import Data.Functor(Functor(fmap))+import Data.Functor.Extend(Extend(extended, duplicated))+import Data.Int(Int)+import Data.Maybe(Maybe(Just, Nothing))+import Data.Ord(Ord)+import Data.Tuple(uncurry)+import Prelude(Show)++-- $setup+-- >>> import Control.Lens((#))+-- >>> import Control.Lens.Fold((^?))+-- >>> import Data.List(reverse)+-- >>> import Prelude(Num((+), (*)))++data IsolateError e =+  NegativeSize+  | IsolateXFail e+  | UnexpectedConsumed Int Int+  deriving (Eq, Ord, Show)++-- |+--+-- >>> isolateError 7 (\_ -> 8) (\_ _ -> 9) (_NegativeSize # ())+-- 7+--+-- >>> isolateError 7 (+10) (\_ _ -> 9) (_IsolateXFail # 99)+-- 109+--+-- >>> isolateError 7 (\_ -> 8) (+) (_UnexpectedConsumed # (12, 14))+-- 26+isolateError ::+  a+  -> (e -> a)+  -> (Int -> Int -> a)+  -> IsolateError e+  -> a+isolateError n _ _ NegativeSize =+  n+isolateError _ f _ (IsolateXFail e) =+  f e+isolateError _ _ u (UnexpectedConsumed m n) =+  u m n++-- | Map a function on the possible failure.+--+-- >>> fmap (+1) (_NegativeSize # () :: IsolateError Int)+-- NegativeSize+--+-- >>> fmap reverse (_IsolateXFail # "abc")+-- IsolateXFail "cba"+--+-- >>> fmap (+1) (_UnexpectedConsumed # (7, 8) :: IsolateError Int)+-- UnexpectedConsumed 7 8+instance Functor IsolateError where+  fmap _ NegativeSize =+    NegativeSize+  fmap f (IsolateXFail e) =+    IsolateXFail (f e)+  fmap _ (UnexpectedConsumed m n) =+    UnexpectedConsumed m n++-- | Duplicate on the possible failure.+--+-- >>> extended (isolateError 12 (+10) (*)) (_IsolateXFail # 99)+-- IsolateXFail 109+--+-- >>> extended (isolateError 12 (+10) (*)) (_UnexpectedConsumed # (12, 13))+-- UnexpectedConsumed 12 13+--+-- >>> extended (isolateError 12 (+10) (*)) (_NegativeSize # ())+-- NegativeSize+instance Extend IsolateError where+  extended _ NegativeSize =+    NegativeSize+  extended f i@(IsolateXFail _) =+    IsolateXFail (f i)+  extended _ (UnexpectedConsumed m n) =+    UnexpectedConsumed m n+  duplicated NegativeSize =+    NegativeSize+  duplicated i@(IsolateXFail _) =+    IsolateXFail i+  duplicated (UnexpectedConsumed m n) =+    UnexpectedConsumed m n++-- |+--+-- >>> _NegativeSize # ()+-- NegativeSize+--+-- >>> (_NegativeSize # ()) ^? _NegativeSize+-- Just ()+--+-- >>> (_IsolateXFail # 8) ^? _NegativeSize+-- Nothing+--+-- >>> (_UnexpectedConsumed # (12, 13)) ^? _NegativeSize+-- Nothing+_NegativeSize ::+  Prism' (IsolateError e) ()+_NegativeSize =+  prism'+    (const NegativeSize)+    (\x -> case x of+             NegativeSize -> Just ()+             _ -> Nothing)++-- |+--+-- >>> _IsolateXFail # 8+-- IsolateXFail 8+--+-- >>> (_NegativeSize # ()) ^? _IsolateXFail+-- Nothing+--+-- >>> (_IsolateXFail # 8) ^? _IsolateXFail+-- Just 8+--+-- >>> (_UnexpectedConsumed # (12, 13)) ^? _IsolateXFail+-- Nothing+_IsolateXFail ::+  Prism' (IsolateError e) e+_IsolateXFail =+  prism'+    IsolateXFail+    (\x -> case x of+             IsolateXFail e -> Just e+             _ -> Nothing)++-- |+--+-- >>> _UnexpectedConsumed # (12,13)+-- UnexpectedConsumed 12 13+--+-- >>> (_NegativeSize # ()) ^? _UnexpectedConsumed+-- Nothing+--+-- >>> (_IsolateXFail # 8) ^? _UnexpectedConsumed+-- Nothing+--+-- >>> (_UnexpectedConsumed # (12, 13)) ^? _UnexpectedConsumed+-- Just (12,13)+_UnexpectedConsumed ::+  Prism' (IsolateError e) (Int, Int)+_UnexpectedConsumed =+  prism'+    (uncurry UnexpectedConsumed)+    (\x -> case x of+             UnexpectedConsumed l m -> Just (l, m)+             _ -> Nothing)
+ src/Data/Tickle/RunGetResult.hs view
@@ -0,0 +1,416 @@+{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE Safe #-}++module Data.Tickle.RunGetResult(+  -- * Data type+  RunGetResult+  -- * Reduction+, runGetResult+  -- * Prisms+, _RunGetFail+, _RunGet+  -- * Isomorphisms+, runGetResultEitherIso+, runGetResultValidationIso+, runGetResultValidation'Iso+, runGetResultAccValidationIso+) where++import Control.Applicative(Applicative((<*>), pure), (<$>))+import Control.Category(Category((.), id))+import Control.Lens.Iso(iso, from)+import Control.Lens.Prism(prism')+import Control.Lens.Type(Iso, Prism')+import Control.Monad(Monad((>>=), return))+import Data.Bifoldable(Bifoldable(bifoldMap))+import Data.Bifunctor(Bifunctor(bimap))+import Data.Bitraversable(Bitraversable(bitraverse))+import Data.Either(Either(Left, Right))+import Data.Eq(Eq)+import Data.Foldable(Foldable(foldMap))+import Data.Functor(Functor(fmap))+import Data.Functor.Apply(Apply((<.>)))+import Data.Functor.Alt(Alt((<!>)))+import Data.Functor.Bind(Bind((>>-)))+import Data.Functor.Extend(Extend(extended, duplicated))+import Data.Int(Int64)+import Data.Maybe(Maybe(Nothing, Just))+import Data.Monoid(Monoid(mempty))+import Data.Ord(Ord)+import Data.Semigroup(Semigroup((<>)))+import Data.Traversable(Traversable(traverse))+import Data.Tuple(uncurry)+import Data.Validation(Validation, AccValidation, Validation', Validate(_Either, _Validation'))+import Prelude(Show)++-- $setup+-- >>> import Control.Lens((#))+-- >>> import Control.Lens.Fold((^?))+-- >>> import Control.Lens.Prism(_Right, _Left)+-- >>> import Data.Eq(Eq((==)))+-- >>> import Data.Int(Int)+-- >>> import Data.List((++))+-- >>> import Data.String(String)+-- >>> import Data.Validation(_Success, _Failure)+-- >>> import Prelude(Num((*), (+), (-)), subtract, even, mod)++data RunGetResult e a = +  RunGetFail Int64 e+  | RunGet a+  deriving (Eq, Ord, Show)++-- |+--+-- >>> runGetResult (+) (*2) (_RunGet # 12)+-- 24+--+-- >>> runGetResult (+) (*2) (_RunGetFail # (23, 12))+-- 35+runGetResult ::+  (Int64 -> e -> x)+  -> (a -> x)+  -> RunGetResult e a+  -> x+runGetResult f _ (RunGetFail i e) =+  f i e+runGetResult _ r (RunGet a) =+  r a++-- |+--+-- >>> bimap (+10) (*2) (_RunGet # 12)+-- RunGet 24+--+-- >>> bimap (+10) (*2) (_RunGetFail # (2, 3))+-- RunGetFail 2 13+instance Bifunctor RunGetResult where+  bimap f _ (RunGetFail i e) =+    RunGetFail i (f e)+  bimap _ g (RunGet a) =+    RunGet (g a)++-- |+--+-- >>> fmap (*2) (_RunGet # 8)+-- RunGet 16+--+-- >>> fmap (*2) (_RunGetFail # (9, 13))+-- RunGetFail 9 13+instance Functor (RunGetResult e) where+  fmap =+    bimap id++-- |+--+-- >>>  bifoldMap (++"abc") (++"def") (_RunGet # "hi")+-- "hidef"+--+-- >>>  bifoldMap (++"abc") (++"def") (_RunGetFail # (12, "hi"))+-- "hiabc"+instance Bifoldable RunGetResult where+  bifoldMap f _ (RunGetFail _ e) =+    f e+  bifoldMap _ g (RunGet a) =+    g a++-- |+--+-- >>> foldMap (++"abc") (_RunGet # "hi")+-- "hiabc"+--+-- >>> foldMap (++"abc") (_RunGetFail # (12, "hi"))+-- ""+instance Foldable (RunGetResult e) where+  foldMap _ (RunGetFail _ _) =+    mempty+  foldMap f (RunGet a) =+    f a++-- |+--+-- >>> bitraverse (\n -> if even n then [n - 1] else [n * 2]) (\n -> if n `mod` 5 == 0 then [n + 1] else [n * 7]) (_RunGet # 8)+-- [RunGet 56]+--+-- >>> bitraverse (\n -> if even n then [n - 1] else [n * 2]) (\n -> if n `mod` 5 == 0 then [n + 1] else [n * 7]) (_RunGet # 9)+-- [RunGet 63]+--+-- >>> bitraverse (\n -> if even n then [n - 1] else [n * 2]) (\n -> if n `mod` 5 == 0 then [n + 1] else [n * 7]) (_RunGet # 10)+-- [RunGet 11]+--+-- λ> bitraverse (\n -> if even n then [n - 1] else [n * 2]) (\n -> if n `mod` 5 == 0 then [n + 1] else [n * 7]) (_RunGetFail # (8, 18))+-- [RunGetFail 8 17]+--+-- >>> bitraverse (\n -> if even n then [n - 1] else [n * 2]) (\n -> if n `mod` 5 == 0 then [n + 1] else [n * 7]) (_RunGetFail # (8, 19))+-- [RunGetFail 8 38]+--+-- >>> bitraverse (\n -> if even n then [n - 1] else [n * 2]) (\n -> if n `mod` 5 == 0 then [n + 1] else [n * 7]) (_RunGetFail # (8, 20))+-- [RunGetFail 8 19]+instance Bitraversable RunGetResult where+  bitraverse f _ (RunGetFail i e) =+    RunGetFail i <$> f e+  bitraverse _ g (RunGet a) =+    RunGet <$> g a++-- |+--+-- >>> traverse (\n -> if n `mod` 5 == 0 then [n + 1] else [n * 7]) (_RunGet # 8)+-- [RunGet 56]+--+-- >>> traverse (\n -> if n `mod` 5 == 0 then [n + 1] else [n * 7]) (_RunGet # 10)+-- [RunGet 11]+instance Traversable (RunGetResult e) where+  traverse =+    bitraverse pure++-- |+--+-- >>> _RunGet # (*2) <.> _RunGet # 9+-- RunGet 18+--+-- >>> _RunGetFail # (10, 2) <.> _RunGet # 9+-- RunGetFail 10 2+--+-- >>> _RunGet # (*2) <.> _RunGetFail # (11, 3)+-- RunGetFail 11 3+--+-- >>> _RunGetFail # (10, 2) <.> _RunGetFail # (11, 3)+-- RunGetFail 10 2+instance Apply (RunGetResult e) where+  RunGet f <.> RunGet a =+    RunGet (f a)+  RunGet _ <.> RunGetFail i e =+    RunGetFail i e+  RunGetFail i e <.> _ =+    RunGetFail i e+    +-- |+--+-- >>> pure 7 :: RunGetResult () Int+-- RunGet 7+--+-- >>> _RunGet # (*2) <*> _RunGet # 9+-- RunGet 18+--+-- >>> _RunGetFail # (10, 2) <*> _RunGet # 9+-- RunGetFail 10 2+--+-- >>> _RunGet # (*2) <*> _RunGetFail # (11, 3)+-- RunGetFail 11 3+--+-- >>> _RunGetFail # (10, 2) <*> _RunGetFail # (11, 3)+-- RunGetFail 10 2+instance Applicative (RunGetResult e) where+  RunGet f <*> RunGet a =+    RunGet (f a)+  RunGet _ <*> RunGetFail i e =+    RunGetFail i e+  RunGetFail i e <*> _ =+    RunGetFail i e+  pure =+    RunGet++-- |+--+-- >>> return 7 :: RunGetResult () Int+-- RunGet 7+--+-- >>> _RunGet # 8 >>- \g -> if even g then _RunGet # (g * 2) else _RunGetFail # (13, g * 14)+-- RunGet 16+--+-- >>> _RunGet # 9 >>- \g -> if even g then _RunGet # (g * 2) else _RunGetFail # (13, g * 14)+-- RunGetFail 13 126+--+-- >>> _RunGetFail # (10, 8) >>- \g -> if even g then _RunGet # (g * 2) else _RunGetFail # (13, g * 14)+-- RunGetFail 10 8+instance Bind (RunGetResult e) where+  RunGet a >>- f =+    f a+  RunGetFail i e >>- _ =+    RunGetFail i e++-- |+--+-- >>> _RunGet # 8 >>= \g -> if even g then _RunGet # (g * 2) else _RunGetFail # (13, g * 14)+-- RunGet 16+--+-- >>> _RunGet # 9 >>= \g -> if even g then _RunGet # (g * 2) else _RunGetFail # (13, g * 14)+-- RunGetFail 13 126+--+-- >>> _RunGetFail # (10, 8) >>= \g -> if even g then _RunGet # (g * 2) else _RunGetFail # (13, g * 14)+-- RunGetFail 10 8+instance Monad (RunGetResult e) where+  RunGet a >>= f =+    f a+  RunGetFail i e >>= _ =+    RunGetFail i e+  return =+    RunGet++-- |+--+-- >>> _RunGet # 8 <!> _RunGet # 9+-- RunGet 8+--+-- >>> _RunGet # 8 <!> _RunGetFail # (10, 9)+-- RunGet 8+--+-- >>> _RunGetFail # (10, 8) <!> _RunGet # 9+-- RunGet 9+--+-- >>> _RunGetFail # (10, 8) <!> _RunGet # (20, 9)+-- RunGet (20,9)+instance Alt (RunGetResult e) where+  RunGet a <!> _ =+    RunGet a+  RunGetFail _ _ <!> r =+    r++-- |+--+-- >>> duplicated (_RunGet # 8)+-- RunGet (RunGet 8)+--+-- >>> duplicated (_RunGetFail # (9, "abc"))+-- RunGetFail 9 "abc"+instance Extend (RunGetResult e) where+  extended _ (RunGetFail i e) =+    RunGetFail i e+  extended f g@(RunGet _) =+    RunGet (f g)+  duplicated (RunGetFail i e) = +    RunGetFail i e+  duplicated g@(RunGet _) =+    RunGet g++-- |+--+-- >>> _RunGet # 8 <> _RunGet # 9+-- RunGet 8+--+-- >>> _RunGet # 8 <> _RunGetFail # (10, 9)+-- RunGet 8+--+-- >>> _RunGetFail # (10, 8) <> _RunGet # 9+-- RunGet 9+--+-- >>> _RunGetFail # (10, 8) <> _RunGet # (20, 9)+-- RunGet (20,9)+instance Semigroup (RunGetResult e a) where+  (<>) =+    (<!>)++-- |+--+-- >>> _RunGetFail # (10, "abc")+-- RunGetFail 10 "abc"+--+-- >>> (_RunGet # 8) ^? _RunGetFail+-- Nothing+--+-- >>> (_RunGetFail # (8, "abc")) ^? _RunGetFail+-- Just (8,"abc")+_RunGetFail ::+  Prism' (RunGetResult e a) (Int64, e)+_RunGetFail =+  prism'+    (uncurry RunGetFail)+    (\x -> case x of+             RunGetFail i e -> Just (i, e)+             _ -> Nothing)++-- |+--+-- >>> :t _RunGet # 8+-- _RunGet # 8 :: Num b => RunGetResult e b+--+-- >>> (_RunGet # 8) ^? _RunGet+-- Just 8+--+-- >>> (_RunGetFail # (8, "abc")) ^? _RunGet+-- Nothing+_RunGet ::+  Prism' (RunGetResult e a) a+_RunGet =+  prism'+    RunGet+    (\x -> case x of+             RunGet a -> Just a+             _ -> Nothing)++-- |+--+-- >>> runGetResultEitherIso # Right 99+-- RunGet 99+--+-- >>> runGetResultEitherIso # Left (12, "abc")+-- RunGetFail 12 "abc"+--+-- >>> from runGetResultEitherIso # _RunGet # 99+-- Right 99+--+-- >>> from runGetResultEitherIso # _RunGetFail # (12, "abc")+-- Left (12,"abc")+runGetResultEitherIso ::+  Iso (RunGetResult a b) (RunGetResult b d) (Either (Int64, a) b) (Either (Int64, b) d)+runGetResultEitherIso =+  iso+    (\r -> case r of+             RunGetFail i a -> Left (i, a)+             RunGet b -> Right b)+    (\e -> case e of+             Left (i, a) -> RunGetFail i a+             Right b -> RunGet b)++-- |+--+-- >>> runGetResultValidationIso # _Success # 99+-- RunGet 99+--+-- >>> runGetResultValidationIso # _Failure # (12, "abc")+-- RunGetFail 12 "abc"+--+-- >>> from runGetResultValidationIso # _RunGet # 99+-- Success 99+--+-- >>> from runGetResultValidationIso # _RunGetFail # (12, "abc")+-- Failure (12,"abc")+runGetResultValidationIso ::+  Iso (RunGetResult a b) (RunGetResult b d) (Validation (Int64, a) b) (Validation (Int64, b) d)+runGetResultValidationIso =+  from (_Either . from runGetResultEitherIso)++-- |+--+-- >>> runGetResultValidation'Iso . from _Validation' # _Right # 99+-- RunGet 99+--+-- >>> runGetResultValidation'Iso . from _Validation' # _Left # (12, "abc")+-- RunGetFail 12 "abc"+--+-- >>> from (runGetResultValidation'Iso . from _Validation') # _RunGet # 99 :: Validation (Int64, ()) Int+-- Success 99+--+-- >>> from (runGetResultValidation'Iso . from _Validation') # _RunGetFail # (12, "abc") :: Validation (Int64, String) ()+-- Failure (12,"abc")+runGetResultValidation'Iso ::+  Iso (RunGetResult a b) (RunGetResult b d) (Validation' (Int64, a) b) (Validation' (Int64, b) d)+runGetResultValidation'Iso =+  from (from _Validation' . from runGetResultEitherIso)++-- |+--+-- >>> runGetResultAccValidationIso # _Success # 99+-- RunGet 99+--+-- >>> runGetResultAccValidationIso # _Failure # (12, "abc")+-- RunGetFail 12 "abc"+--+-- >>> from runGetResultAccValidationIso # _RunGet # 99+-- AccSuccess 99+--+-- >>> from runGetResultAccValidationIso # _RunGetFail # (12, "abc")+-- AccFailure (12,"abc")+runGetResultAccValidationIso ::+  Iso (RunGetResult a b) (RunGetResult b d) (AccValidation (Int64, a) b) (AccValidation (Int64, b) d)+runGetResultAccValidationIso =+  from (_Either . from runGetResultEitherIso)
+ test/doctests.hs view
@@ -0,0 +1,32 @@+module Main where++import Build_doctests (deps)+import Control.Applicative+import Control.Monad+import Data.List+import System.Directory+import System.FilePath+import Test.DocTest++main ::+  IO ()+main =+  getSources >>= \sources -> doctest $+      "-isrc"+    : "-idist/build/autogen"+    : "-optP-include"+    : "-optPdist/build/autogen/cabal_macros.h"+    : "-hide-all-packages"+    : map ("-package="++) deps ++ sources++getSources :: IO [FilePath]+getSources = filter (isSuffixOf ".hs") <$> go "src"+  where+    go dir = do+      (dirs, files) <- getFilesAndDirectories dir+      (files ++) . concat <$> mapM go dirs++getFilesAndDirectories :: FilePath -> IO ([FilePath], [FilePath])+getFilesAndDirectories dir = do+  c <- map (dir </>) . filter (`notElem` ["..", "."]) <$> getDirectoryContents dir+  (,) <$> filterM doesDirectoryExist c <*> filterM doesFileExist c
+ tickle.cabal view
@@ -0,0 +1,81 @@+name:               tickle+version:            0.0.1+license:            BSD3+license-file:       LICENSE+author:             Tony Morris <ʇǝu˙sıɹɹoɯʇ@ןןǝʞsɐɥ>+maintainer:         Tony Morris+copyright:          Copyright (C) 2014 NICTA Limited+synopsis:           A port of @Data.Binary@+category:           Data+description:+  <<http://i.imgur.com/Ns5hntl.jpg>>+  .+  A port of @Data.Binary@ that tightens up data types and parameterises error messages+homepage:           https://github.com/tonymorris/tickle+bug-reports:        https://github.com/tonymorris/tickle/issues+cabal-version:      >= 1.10+build-type:         Custom+extra-source-files: changelog, etc/ATTRIBUTIONS++source-repository   head+  type:             git+  location:         git@github.com:tonymorris/tickle.git++flag                small_base+  description:      Choose the new, split-up base package.++library+  default-language:+                    Haskell2010++  build-depends:+                    base < 5 && >= 3+                    , semigroups >= 0.8+                    , semigroupoids >= 4.2+                    , bifunctors >= 3.0+                    , lens >= 4.3.3+                    , bytestring >= 0.10+                    , transformers >= 0.3.0.0+                    , mtl >= 2.1+                    , validation >= 0.3.4+                    +  ghc-options:+                    -Wall++  default-extensions:+  +                    NoImplicitPrelude++  hs-source-dirs:+                    src++  exposed-modules:+                    Data.Tickle+                    Data.Tickle.Get+                    Data.Tickle.IsolateError+                    Data.Tickle.RunGetResult+                    +test-suite doctests+  type:+                    exitcode-stdio-1.0++  main-is:+                    doctests.hs++  default-language:+                    Haskell2010++  build-depends:+                    base < 5 && >= 3+                    , doctest >= 0.9.7+                    , filepath >= 1.3+                    , directory >= 1.1+                    , QuickCheck >= 2.0+                    , template-haskell >= 2.8++  ghc-options:+                    -Wall+                    -threaded++  hs-source-dirs:+                    test