Merge pull request #23 from arbor/extract-lazy-list

add Extract.listLazy

asif.cabal

@@ -136,6 +136,7 @@ test-suite asif-test
   other-modules:
       Arbor.File.Format.Asif.ByteString.BuilderSpec
       Arbor.File.Format.Asif.Data.IpSpec
+      Arbor.File.Format.Asif.ExtractSpec
       Arbor.File.Format.Asif.Format.SegmentValueSpec
       Arbor.File.Format.Asif.Format.TextSpec
       Arbor.File.Format.Asif.WriteSpec

src/Arbor/File/Format/Asif/Extract.hs

@@ -8,26 +8,28 @@
 module Arbor.File.Format.Asif.Extract
   ( formats
   , list
+  , listLazy
   , map
   , vectorBoxed
   , vectorUnboxed
   ) where
 
-import           Arbor.File.Format.Asif.Format.Type (Format)
-import           Arbor.File.Format.Asif.Whatever
-import           Control.Lens
-import           Data.Binary.Get
-import           Data.List                          hiding (map)
-import           Data.Text                          (Text)
-import           Data.Text.Encoding                 (decodeUtf8')
-import           Data.Text.Encoding.Error
-import           Prelude                            hiding (map)
-
-import qualified Data.Binary.Get                    as G
-import qualified Data.ByteString.Lazy               as LBS
-import qualified Data.Map.Strict                    as M
-import qualified Data.Vector                        as V
-import qualified Data.Vector.Unboxed                as VU
+import Arbor.File.Format.Asif.Format.Type (Format)
+import Arbor.File.Format.Asif.Whatever
+import Control.Lens
+import Data.Binary.Get
+import Data.List                          hiding (map)
+import Data.Text                          (Text)
+import Data.Text.Encoding                 (decodeUtf8')
+import Data.Text.Encoding.Error
+import Prelude                            hiding (map)
+
+import qualified Data.Binary.Get      as G
+import qualified Data.ByteString.Lazy as LBS
+import qualified Data.List            as L
+import qualified Data.Map.Strict      as M
+import qualified Data.Vector          as V
+import qualified Data.Vector.Unboxed  as VU
 
 vectorBoxed :: Get a -> LBS.ByteString -> V.Vector a
 vectorBoxed g = V.unfoldr step
@@ -49,6 +51,14 @@ list g = G.runGet go
             then (:) <$> g <*> go
             else return []
 
+listLazy :: Get a -> LBS.ByteString -> [Either String a]
+listLazy g bs =
+  flip L.unfoldr bs $ \acc ->
+    if LBS.null acc then Nothing
+    else case runGetOrFail g acc of
+      Left (_, _, err)  -> Just (Left err, LBS.empty)
+      Right (bs', _, a) -> Just (Right a, bs')
+
 map :: (Ord a) => LBS.ByteString -> Get a -> LBS.ByteString -> Get b -> M.Map a b
 map ks kf vs vf = foldr (\(k, v) m -> M.insert k v m) M.empty $ zip keys values
   where

test/Arbor/File/Format/Asif/ExtractSpec.hs

@@ -0,0 +1,30 @@
+{-# LANGUAGE DataKinds           #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+
+module Arbor.File.Format.Asif.ExtractSpec
+  ( spec
+  ) where
+
+import Arbor.File.Format.Asif.Extract
+import Control.Lens
+
+import qualified Data.Binary.Get         as G
+import qualified Data.ByteString.Builder as BB
+import qualified Data.ByteString.Lazy    as LBS
+
+import HaskellWorks.Hspec.Hedgehog
+import Hedgehog
+import Test.Hspec
+
+import qualified Data.List      as L
+import qualified Hedgehog.Gen   as Gen
+import qualified Hedgehog.Range as Range
+
+{-# ANN module ("HLint: ignore Redundant do"  :: String) #-}
+
+spec :: Spec
+spec = describe "Arbor.File.Format.Asif.ExtractSpec" $ do
+  it "listLazy should extract correct values" $ require $ property $ do
+    ts <- forAll $ Gen.list (Range.linear 0 20) (Gen.int64 (Range.linear 0 maxBound))
+    let body = ts <&> BB.int64LE & mconcat & BB.toLazyByteString
+    listLazy G.getInt64le body === fmap Right ts