asif 1.0.0 → 2.0.0

raw patch · 15 files changed

+154/−152 lines, 15 filesdep +generic-lensPVP ok

version bump matches the API change (PVP)

Dependencies added: generic-lens

API changes (from Hackage documentation)

Files

• app/App/Commands/Dump.hs +24/−23
• app/App/Commands/EncodeFiles.hs +12/−10
• app/App/Commands/ExtractFiles.hs +14/−13
• app/App/Commands/ExtractSegments.hs +10/−9
• app/App/Commands/Options/Lens.hs +0/−12
• app/App/Commands/Options/Type.hs +18/−13
• asif.cabal +7/−6
• src/Arbor/File/Format/Asif/ByteString/Builder.hs +14/−11
• src/Arbor/File/Format/Asif/Format.hs +5/−1
• src/Arbor/File/Format/Asif/Lens.hs +0/−12
• src/Arbor/File/Format/Asif/Segment.hs +17/−14
• src/Arbor/File/Format/Asif/Type.hs +24/−21
• src/Arbor/File/Format/Asif/Whatever.hs +4/−1
• test/Arbor/File/Format/Asif/ByteString/BuilderSpec.hs +5/−5
• test/Arbor/File/Format/Asif/Data/IpSpec.hs +0/−1

@@ -1,5 +1,7 @@+{-# LANGUAGE DataKinds           #-} {-# LANGUAGE OverloadedStrings   #-} {-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeApplications    #-}  module App.Commands.Dump where @@ -13,6 +15,7 @@ import Control.Monad.IO.Class          (liftIO) import Control.Monad.Trans.Resource    (MonadResource, runResourceT) import Data.Char                       (isPrint)+import Data.Generics.Product.Any import Data.List import Data.Maybe import Data.Monoid@@ -25,10 +28,8 @@ import Options.Applicative import System.Locale                   (defaultTimeLocale, iso8601DateFormat) -import qualified App.Commands.Options.Lens              as L import qualified Arbor.File.Format.Asif.ByteString.Lazy as LBS import qualified Arbor.File.Format.Asif.Format          as F-import qualified Arbor.File.Format.Asif.Lens            as L import qualified Data.Attoparsec.ByteString             as AP import qualified Data.Binary                            as G import qualified Data.Binary.Get                        as G@@ -65,8 +66,8 @@  runDump :: MonadResource m => DumpOptions -> m () runDump opt = do-  (_, hIn) <- openFileOrStd (opt ^. L.source) IO.ReadMode-  (_, hOut) <- openFileOrStd (opt ^. L.target) IO.WriteMode+  (_, hIn)  <- openFileOrStd (opt ^. the @"source") IO.ReadMode+  (_, hOut) <- openFileOrStd (opt ^. the @"target") IO.WriteMode    contents <- liftIO $ LBS.hGetContents hIn @@ -75,7 +76,7 @@       liftIO $ IO.hPutStrLn IO.stderr $ "Error occured: " <> errorMessage       return ()     Right segments -> do-      let filenames = fromMaybe "" . (^. L.meta . L.filename) <$> segments+      let filenames = fromMaybe "" . (^. the @"meta" . the @"filename") <$> segments       let namedSegments = zip filenames segments        forM_ (zip [0..] namedSegments) $ \(i :: Int, (filename, segment)) -> do@@ -83,67 +84,67 @@           then liftIO $ IO.hPutStrLn hOut $ "==== [" <> show i <> "] ===="           else liftIO $ IO.hPutStrLn hOut $ "==== [" <> show i <> "] " <> T.unpack filename <> " ====" -        case segment ^. L.meta . L.format of+        case segment ^. the @"meta" . the @"format" of           Just (Known F.StringZ) -> do-            when (LBS.length (segment ^. L.payload) > 0) $-              forM_ (init (LBS.split 0 (segment ^. L.payload))) $ \bs ->+            when (LBS.length (segment ^. the @"payload") > 0) $+              forM_ (init (LBS.split 0 (segment ^. the @"payload"))) $ \bs ->                 liftIO $ IO.hPutStrLn hOut $ T.unpack (T.decodeUtf8 (LBS.toStrict bs))           Just (Known (F.Repeat n F.Char)) ->-            forM_ (LBS.chunkBy (fromIntegral n) (segment ^. L.payload)) $ \bs ->+            forM_ (LBS.chunkBy (fromIntegral n) (segment ^. the @"payload")) $ \bs ->               liftIO $ IO.hPutStrLn hOut $ T.unpack (T.decodeUtf8 (LBS.toStrict bs))           Just (Known F.TimeMillis64LE) ->-            forM_ (LBS.chunkBy 8 (segment ^. L.payload)) $ \bs -> do+            forM_ (LBS.chunkBy 8 (segment ^. the @"payload")) $ \bs -> do               let w = G.runGet G.getInt64le (LBS.take 8 (bs <> LBS.replicate 8 0))               let t :: POSIXTime = (w `div` 1000) ^. from microseconds               liftIO $ IO.hPutStrLn hOut $ showTime (posixSecondsToUTCTime t) <> " (" <> show w <> " ms)"           Just (Known F.TimeMicros64LE) ->-            forM_ (LBS.chunkBy 8 (segment ^. L.payload)) $ \bs -> do+            forM_ (LBS.chunkBy 8 (segment ^. the @"payload")) $ \bs -> do               let w = G.runGet G.getInt64le (LBS.take 8 (bs <> LBS.replicate 8 0))               let t :: POSIXTime = w ^. from microseconds               liftIO $ IO.hPutStrLn hOut $ showTime (posixSecondsToUTCTime t) <> " (" <> show w <> " µs)"           Just (Known F.Ipv4) ->-            forM_ (LBS.chunkBy 4 (segment ^. L.payload)) $ \bs -> do+            forM_ (LBS.chunkBy 4 (segment ^. the @"payload")) $ \bs -> do               let w = G.runGet G.getWord32le (LBS.take 8 (bs <> LBS.replicate 4 0))               let ipString = w & word32ToIpv4 & ipv4ToString               liftIO $ IO.hPutStrLn hOut $ ipString <> replicate (16 - length ipString) ' ' <> "(" <> show w <> ")"           Just (Known F.Int64LE) ->-            forM_ (LBS.chunkBy 8 (segment ^. L.payload)) $ \bs -> do+            forM_ (LBS.chunkBy 8 (segment ^. the @"payload")) $ \bs -> do               let w = G.runGet G.getInt64le (LBS.take 8 (bs <> LBS.replicate 8 0))               liftIO $ IO.hPrint hOut w           Just (Known F.Int32LE) ->-            forM_ (LBS.chunkBy 4 (segment ^. L.payload)) $ \bs -> do+            forM_ (LBS.chunkBy 4 (segment ^. the @"payload")) $ \bs -> do               let w = G.runGet G.getInt32le (LBS.take 4 (bs <> LBS.replicate 4 0))               liftIO $ IO.hPrint hOut w           Just (Known F.Int16LE) ->-            forM_ (LBS.chunkBy 2 (segment ^. L.payload)) $ \bs -> do+            forM_ (LBS.chunkBy 2 (segment ^. the @"payload")) $ \bs -> do               let w = G.runGet G.getInt16le (LBS.take 2 (bs <> LBS.replicate 2 0))               liftIO $ IO.hPrint hOut w           Just (Known F.Int8) ->-            forM_ (LBS.chunkBy 1 (segment ^. L.payload)) $ \bs -> do+            forM_ (LBS.chunkBy 1 (segment ^. the @"payload")) $ \bs -> do               let w = G.runGet G.getInt8 (LBS.take 1 (bs <> LBS.replicate 1 0))               liftIO $ IO.hPrint hOut w           Just (Known F.Word64LE) ->-            forM_ (LBS.chunkBy 8 (segment ^. L.payload)) $ \bs -> do+            forM_ (LBS.chunkBy 8 (segment ^. the @"payload")) $ \bs -> do               let w = G.runGet G.getWord64le (LBS.take 8 (bs <> LBS.replicate 8 0))               liftIO $ IO.hPrint hOut w           Just (Known F.Word32LE) ->-            forM_ (LBS.chunkBy 4 (segment ^. L.payload)) $ \bs -> do+            forM_ (LBS.chunkBy 4 (segment ^. the @"payload")) $ \bs -> do               let w = G.runGet G.getWord32le (LBS.take 4 (bs <> LBS.replicate 4 0))               liftIO $ IO.hPrint hOut w           Just (Known F.Word16LE) ->-            forM_ (LBS.chunkBy 2 (segment ^. L.payload)) $ \bs -> do+            forM_ (LBS.chunkBy 2 (segment ^. the @"payload")) $ \bs -> do               let w = G.runGet G.getWord16le (LBS.take 2 (bs <> LBS.replicate 2 0))               liftIO $ IO.hPrint hOut w           Just (Known F.Word8) ->-            forM_ (LBS.chunkBy 1 (segment ^. L.payload)) $ \bs -> do+            forM_ (LBS.chunkBy 1 (segment ^. the @"payload")) $ \bs -> do               let w = G.runGet G.getWord8 (LBS.take 1 (bs <> LBS.replicate 1 0))               liftIO $ IO.hPrint hOut w           Just (Known F.Text) ->-            liftIO $ LBSC.hPutStrLn hOut (segment ^. L.payload)+            liftIO $ LBSC.hPutStrLn hOut (segment ^. the @"payload")           Just (Known F.BitString) ->-            liftIO $ IO.hPutStrLn hOut (bitShow (segment ^. L.payload))+            liftIO $ IO.hPutStrLn hOut (bitShow (segment ^. the @"payload"))           _ ->-            forM_ (zip (LBS.chunkBy 16 (segment ^. L.payload)) [0 :: Int, 16..]) $ \(bs, j) -> do+            forM_ (zip (LBS.chunkBy 16 (segment ^. the @"payload")) [0 :: Int, 16..]) $ \(bs, j) -> do               let bytes = mconcat (intersperse " " (reverse . take 2 . reverse . ('0':) . flip showHex "" <$> LBS.unpack bs))               liftIO $ IO.hPutStr hOut $ reverse $ take 8 $ reverse $ ("0000000" ++) $ showHex j ""               liftIO $ IO.hPutStr hOut "  "

@@ -1,4 +1,6 @@+{-# LANGUAGE DataKinds           #-} {-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeApplications    #-}  module App.Commands.EncodeFiles where @@ -10,16 +12,16 @@ import Control.Monad import Control.Monad.IO.Class                    (liftIO) import Control.Monad.Trans.Resource              (MonadResource, runResourceT)+import Data.Generics.Product.Any import Data.Monoid import Options.Applicative -import qualified App.Commands.Options.Lens as L-import qualified Data.ByteString           as BS-import qualified Data.Conduit              as C-import qualified Data.Conduit.Binary       as C-import qualified Data.Text                 as T-import qualified Data.Text.Encoding        as T-import qualified System.IO                 as IO+import qualified Data.ByteString     as BS+import qualified Data.Conduit        as C+import qualified Data.Conduit.Binary as C+import qualified Data.Text           as T+import qualified Data.Text.Encoding  as T+import qualified System.IO           as IO  parseEncodeFilesOptions :: Parser EncodeFilesOptions parseEncodeFilesOptions = EncodeFilesOptions@@ -45,7 +47,7 @@  runEncodeFiles :: MonadResource m => EncodeFilesOptions -> m () runEncodeFiles opt = do-  let sourcePath = opt ^. L.source+  let sourcePath = opt ^. the @"source"   filenamesContents <- liftIO $ BS.readFile (sourcePath <> "/.asif/filenames")   let filenames = mfilter (/= "") $ T.decodeUtf8 <$> BS.split 0 filenamesContents @@ -54,9 +56,9 @@     liftIO $ IO.hSeek h IO.SeekFromEnd 0     return h -  let contents = segmentsRawC (opt ^. L.asifType) handles+  let contents = segmentsRawC (opt ^. the @"asifType") handles -  (_, hTarget) <- openFileOrStd (opt ^. L.target) IO.WriteMode+  (_, hTarget) <- openFileOrStd (opt ^. the @"target") IO.WriteMode    C.runConduit $ contents .| C.sinkHandle hTarget 

@@ -1,4 +1,6 @@+{-# LANGUAGE DataKinds           #-} {-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeApplications    #-}  module App.Commands.ExtractFiles where @@ -9,21 +11,20 @@ import Control.Monad import Control.Monad.IO.Class import Control.Monad.Trans.Resource   (MonadResource, runResourceT)+import Data.Generics.Product.Any import Data.List import Data.Maybe import Data.Monoid import Options.Applicative import System.Directory -import qualified App.Commands.Options.Lens   as L-import qualified Arbor.File.Format.Asif.Lens as L-import qualified Data.Attoparsec.ByteString  as AP-import qualified Data.ByteString             as BS-import qualified Data.ByteString.Lazy        as LBS-import qualified Data.Map                    as M-import qualified Data.Text                   as T-import qualified System.Directory            as IO-import qualified System.IO                   as IO+import qualified Data.Attoparsec.ByteString as AP+import qualified Data.ByteString            as BS+import qualified Data.ByteString.Lazy       as LBS+import qualified Data.Map                   as M+import qualified Data.Text                  as T+import qualified System.Directory           as IO+import qualified System.IO                  as IO  parseExtractFilesOptions :: Parser ExtractFilesOptions parseExtractFilesOptions = ExtractFilesOptions@@ -44,16 +45,16 @@  runExtractFiles :: MonadResource m => ExtractFilesOptions -> m () runExtractFiles opt = do-  (_, hIn) <- openFileOrStd (opt ^. L.source) IO.ReadMode+  (_, hIn) <- openFileOrStd (opt ^. the @"source") IO.ReadMode   contents <- liftIO $ LBS.hGetContents hIn   case extractSegments magic contents of     Left errorMessage -> do       liftIO $ IO.hPutStrLn IO.stderr $ "Error occured: " <> errorMessage       return ()     Right segments -> do-      let filenames = fromMaybe "" . (^. L.meta . L.filename) <$> segments+      let filenames = fromMaybe "" . (^. the @"meta" . the @"filename") <$> segments       let namedSegments = M.fromList $ mfilter ((/= "") . fst) (zip filenames segments)-      let targetPath = opt ^. L.target+      let targetPath = opt ^. the @"target"        liftIO $ IO.hPutStrLn IO.stderr $ "Writing to: " <> targetPath       liftIO $ createDirectoryIfMissing True targetPath@@ -64,7 +65,7 @@             let outFilename = T.pack targetPath <> "/" <> filename             let basename = mconcat (intersperse "/" (init (T.splitOn "/" outFilename)))             liftIO $ IO.createDirectoryIfMissing True (T.unpack basename)-            liftIO $ LBS.writeFile (T.unpack outFilename) (segment ^. L.payload)+            liftIO $ LBS.writeFile (T.unpack outFilename) (segment ^. the @"payload")           Nothing ->             liftIO $ IO.hPutStrLn IO.stderr $ "Segment " <> show i <> " has no filename.  Skipping" 

@@ -1,4 +1,6 @@+{-# LANGUAGE DataKinds           #-} {-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeApplications    #-}  module App.Commands.ExtractSegments where @@ -9,17 +11,16 @@ import Control.Monad import Control.Monad.IO.Class         (liftIO) import Control.Monad.Trans.Resource   (MonadResource, runResourceT)+import Data.Generics.Product.Any import Data.Monoid import Options.Applicative import System.Directory import Text.Printf -import qualified App.Commands.Options.Lens   as L-import qualified Arbor.File.Format.Asif.Lens as L-import qualified Data.Attoparsec.ByteString  as AP-import qualified Data.ByteString             as BS-import qualified Data.ByteString.Lazy        as LBS-import qualified System.IO                   as IO+import qualified Data.Attoparsec.ByteString as AP+import qualified Data.ByteString            as BS+import qualified Data.ByteString.Lazy       as LBS+import qualified System.IO                  as IO  parseExtractSegmentsOptions :: Parser ExtractSegmentsOptions parseExtractSegmentsOptions = ExtractSegmentsOptions@@ -40,7 +41,7 @@  runExtractSegments :: MonadResource m => ExtractSegmentsOptions -> m () runExtractSegments opt = do-  (_, hIn) <- openFileOrStd (opt ^. L.source) IO.ReadMode+  (_, hIn) <- openFileOrStd (opt ^. the @"source") IO.ReadMode   contents <- liftIO $ LBS.hGetContents hIn   -- TODO pass in magic   case extractSegments magic contents of@@ -48,12 +49,12 @@       liftIO $ IO.hPutStrLn IO.stderr $ "Error occured: " <> errorMessage       return ()     Right segments -> do-      let targetPath = opt ^. L.target+      let targetPath = opt ^. the @"target"        liftIO $ IO.hPutStrLn IO.stderr $ "Writing to: " <> targetPath        liftIO $ createDirectoryIfMissing True targetPath        forM_ (zip [0..] segments) $ \(i :: Int, segment) ->-        liftIO $ LBS.writeFile (targetPath <> "/" <> printf "%03d" i <> ".seg") (segment ^. L.payload)+        liftIO $ LBS.writeFile (targetPath <> "/" <> printf "%03d" i <> ".seg") (segment ^. the @"payload")   where magic = AP.string "seg:" *> (BS.pack <$> many AP.anyWord8) AP.<?> "\"seg:????\""

@@ -1,12 +0,0 @@-{-# LANGUAGE FunctionalDependencies #-}-{-# LANGUAGE TemplateHaskell        #-}--module App.Commands.Options.Lens where--import App.Commands.Options.Type-import Control.Lens--makeFields ''DumpOptions-makeFields ''EncodeFilesOptions-makeFields ''ExtractFilesOptions-makeFields ''ExtractSegmentsOptions

@@ -1,22 +1,27 @@+{-# LANGUAGE DeriveGeneric         #-}+{-# LANGUAGE DuplicateRecordFields #-}+ module App.Commands.Options.Type where +import GHC.Generics+ data EncodeFilesOptions = EncodeFilesOptions-  { encodeFilesOptionsSource   :: FilePath-  , encodeFilesOptionsTarget   :: FilePath-  , encodeFilesOptionsAsifType :: String-  } deriving (Eq, Show)+  { source   :: FilePath+  , target   :: FilePath+  , asifType :: String+  } deriving (Eq, Show, Generic)  data ExtractFilesOptions = ExtractFilesOptions-  { extractFilesOptionsSource :: FilePath-  , extractFilesOptionsTarget :: FilePath-  } deriving (Eq, Show)+  { source :: FilePath+  , target :: FilePath+  } deriving (Eq, Show, Generic)  data ExtractSegmentsOptions = ExtractSegmentsOptions-  { extractSegmentsOptionsSource :: FilePath-  , extractSegmentsOptionsTarget :: FilePath-  } deriving (Eq, Show)+  { source :: FilePath+  , target :: FilePath+  } deriving (Eq, Show, Generic)  data DumpOptions = DumpOptions-  { dumpOptionsSource :: FilePath-  , dumpOptionsTarget :: FilePath-  } deriving (Eq, Show)+  { source :: FilePath+  , target :: FilePath+  } deriving (Eq, Show, Generic)

@@ -2,16 +2,16 @@ -- -- see: https://github.com/sol/hpack ----- hash: 975b1a79df9badb8768dba82941d8968275d859920847e829d62a65978901884+-- hash: de051b0b916332afc5b6b544ffaf3c0cabbf5c7dbc32317927f1dbe7b6e0c55c  name:           asif-version:        1.0.0+version:        2.0.0 description:    Please see the README on Github at <https://github.com/packetloop/asif#readme> category:       Services homepage:       https://github.com/packetloop/asif#readme bug-reports:    https://github.com/packetloop/asif/issues-author:         Tyler Durden-maintainer:     tyler.durden@arbor.net+author:         Arbor Networks+maintainer:     mayhem@arbor.net copyright:      Arbor Networks license:        MIT license-file:   LICENSE@@ -42,6 +42,7 @@     , cpu     , either     , exceptions+    , generic-lens     , hw-bits     , iproute     , lens@@ -63,7 +64,6 @@       Arbor.File.Format.Asif.Format       Arbor.File.Format.Asif.Get       Arbor.File.Format.Asif.IO-      Arbor.File.Format.Asif.Lens       Arbor.File.Format.Asif.Lookup       Arbor.File.Format.Asif.Segment       Arbor.File.Format.Asif.Type@@ -94,6 +94,7 @@     , directory     , either     , exceptions+    , generic-lens     , hw-bits     , iproute     , lens@@ -110,7 +111,6 @@       App.Commands.EncodeFiles       App.Commands.ExtractFiles       App.Commands.ExtractSegments-      App.Commands.Options.Lens       App.Commands.Options.Type       App.IO       Paths_asif@@ -137,6 +137,7 @@     , cpu     , either     , exceptions+    , generic-lens     , hedgehog     , hspec     , hw-bits

@@ -1,3 +1,6 @@+{-# LANGUAGE DataKinds        #-}+{-# LANGUAGE TypeApplications #-}+ module Arbor.File.Format.Asif.ByteString.Builder   ( magicString   , withSize@@ -7,7 +10,6 @@   , magicLength   ) where -import Arbor.File.Format.Asif.Type import Arbor.File.Format.Asif.Whatever import Conduit import Control.Lens@@ -15,6 +17,7 @@ import Data.Bits import Data.ByteString.Builder import Data.Conduit                    (Source)+import Data.Generics.Product.Any import Data.Int import Data.Maybe import Data.Monoid@@ -25,7 +28,7 @@  import qualified Arbor.File.Format.Asif.Format as F import qualified Arbor.File.Format.Asif.IO     as IO-import qualified Arbor.File.Format.Asif.Lens   as L+import qualified Arbor.File.Format.Asif.Type   as Z import qualified Data.ByteString               as BS import qualified Data.ByteString.Builder       as B import qualified Data.ByteString.Lazy          as LBS@@ -91,7 +94,7 @@ segmentsC :: (MonadIO m, MonadResource m)   => String   -> Maybe POSIXTime-  -> [Segment IO.Handle]+  -> [Z.Segment IO.Handle]   -> m (Source m BS.ByteString) segmentsC asifType maybeTimestamp metas = do   fileTime <- maybe (liftIO getPOSIXTime) return maybeTimestamp@@ -99,18 +102,18 @@   (_, _, hCreateTimes ) <- IO.openTempFile Nothing "asif-timestamps"   (_, _, hFormats     ) <- IO.openTempFile Nothing "asif-formats" -  let metaMeta        = metaCreateTime fileTime-  let metaFilenames   = segment hFilenames    $ metaMeta <> metaFilename ".asif/filenames"   <> metaFormat (Known F.StringZ)-  let metaCreateTimes = segment hCreateTimes  $ metaMeta <> metaFilename ".asif/createtimes" <> metaFormat (Known F.TimeMicros64LE)-  let metaFormats     = segment hFormats      $ metaMeta <> metaFilename ".asif/formats"     <> metaFormat (Known F.StringZ)+  let metaMeta        = Z.metaCreateTime fileTime+  let metaFilenames   = Z.segment hFilenames    $ metaMeta <> Z.metaFilename ".asif/filenames"   <> Z.metaFormat (Known F.StringZ)+  let metaCreateTimes = Z.segment hCreateTimes  $ metaMeta <> Z.metaFilename ".asif/createtimes" <> Z.metaFormat (Known F.TimeMicros64LE)+  let metaFormats     = Z.segment hFormats      $ metaMeta <> Z.metaFilename ".asif/formats"     <> Z.metaFormat (Known F.StringZ)   let moreMetas       = metaFilenames:metaCreateTimes:metaFormats:metas    forM_ moreMetas $ \meta -> do-    liftIO $ B.hPutBuilder hFilenames   $ B.byteString (meta ^. L.meta . L.filename & fromMaybe "" & T.encodeUtf8) <> B.word8 0-    liftIO $ B.hPutBuilder hCreateTimes $ B.int64LE $ (meta ^. L.meta . L.createTime) <&> (^. microseconds) & fromMaybe 0-    liftIO $ B.hPutBuilder hFormats     $ B.byteString (meta ^. L.meta . L.format <&> tShowWhatever & fromMaybe "" & T.encodeUtf8) <> B.word8 0+    liftIO $ B.hPutBuilder hFilenames   $ B.byteString (meta ^. the @"meta" . the @"filename" & fromMaybe "" & T.encodeUtf8) <> B.word8 0+    liftIO $ B.hPutBuilder hCreateTimes $ B.int64LE $ (meta ^. the @"meta" . the @"createTime") <&> (^. microseconds) & fromMaybe 0+    liftIO $ B.hPutBuilder hFormats     $ B.byteString (meta ^. the @"meta" . the @"format" <&> tShowWhatever & fromMaybe "" & T.encodeUtf8) <> B.word8 0     return () -  let source = segmentsRawC asifType ((^. L.payload) <$> moreMetas)+  let source = segmentsRawC asifType ((^. the @"payload") <$> moreMetas)    return source

@@ -1,5 +1,9 @@+{-# LANGUAGE DeriveGeneric #-}+ module Arbor.File.Format.Asif.Format where +import GHC.Generics+ data Format   = Binary   | BitString@@ -18,4 +22,4 @@   | Word16LE   | Word32LE   | Word64LE-  deriving (Eq, Read, Show)+  deriving (Eq, Read, Show, Generic)

@@ -1,12 +0,0 @@-{-# LANGUAGE FunctionalDependencies #-}-{-# LANGUAGE TemplateHaskell        #-}--module Arbor.File.Format.Asif.Lens where--import Arbor.File.Format.Asif.Format-import Arbor.File.Format.Asif.Type-import Control.Lens--makeFields ''Format-makeFields ''Segment-makeFields ''SegmentMeta

@@ -1,5 +1,8 @@+{-# LANGUAGE DataKinds        #-}+{-# LANGUAGE TypeApplications #-}+ module Arbor.File.Format.Asif.Segment-  ( Segment(..)+  ( Z.Segment(..)   , mkDefaultSegment   , extractSegments   , extractNamedSegments@@ -9,27 +12,27 @@ import Arbor.File.Format.Asif.ByIndex import Arbor.File.Format.Asif.Get import Arbor.File.Format.Asif.Lookup-import Arbor.File.Format.Asif.Type import Control.Lens import Control.Monad import Data.Binary.Get+import Data.Generics.Product.Any import Data.Maybe import Data.Monoid import Data.Text                      (Text, pack)  import qualified Arbor.File.Format.Asif.Extract as E import qualified Arbor.File.Format.Asif.Get     as G-import qualified Arbor.File.Format.Asif.Lens    as L+import qualified Arbor.File.Format.Asif.Type    as Z import qualified Data.Attoparsec.ByteString     as AP import qualified Data.ByteString                as BS import qualified Data.ByteString.Lazy           as LBS import qualified Data.ByteString.Lazy.Char8     as LC8 import qualified Data.Map.Strict                as M -mkDefaultSegment :: LBS.ByteString -> Segment LBS.ByteString-mkDefaultSegment bs = segment bs mempty+mkDefaultSegment :: LBS.ByteString -> Z.Segment LBS.ByteString+mkDefaultSegment bs = Z.segment bs mempty -extractSegments :: AP.Parser BS.ByteString -> LBS.ByteString -> Either String [Segment LBS.ByteString]+extractSegments :: AP.Parser BS.ByteString -> LBS.ByteString -> Either String [Z.Segment LBS.ByteString] extractSegments magicParser bs = do   bss <- extractSegmentByteStrings magicParser bs   case bss of@@ -40,18 +43,18 @@          let metas = mempty               <> ByIndex (replicate (length bss) mempty)-              <> ByIndex (metaFilename    <$> filenames)-              <> ByIndex (metaCreateTime  <$> lookupSegment ".asif/createtimes" namedSegments (E.list G.getTimeMicro64))-              <> ByIndex (metaMaybeFormat <$> lookupSegment ".asif/formats"     namedSegments E.formats)+              <> ByIndex (Z.metaFilename    <$> filenames)+              <> ByIndex (Z.metaCreateTime  <$> lookupSegment ".asif/createtimes" namedSegments (E.list G.getTimeMicro64))+              <> ByIndex (Z.metaMaybeFormat <$> lookupSegment ".asif/formats"     namedSegments E.formats) -        return $ uncurry segment <$> zip bss (unByIndex metas)+        return $ uncurry Z.segment <$> zip bss (unByIndex metas)       else return (mkDefaultSegment <$> bss)     _      -> return (mkDefaultSegment <$> bss) -extractNamedSegments :: AP.Parser BS.ByteString -> LBS.ByteString -> Either String (M.Map Text (Segment LBS.ByteString))+extractNamedSegments :: AP.Parser BS.ByteString -> LBS.ByteString -> Either String (M.Map Text (Z.Segment LBS.ByteString)) extractNamedSegments magicParser bs = do   segments <- extractSegments magicParser bs-  let filenames = fromMaybe "" . (^. L.meta . L.filename) <$> segments+  let filenames = fromMaybe "" . (^. the @"meta" . the @"filename") <$> segments   return $ M.fromList $ zip filenames segments  extractSegmentByteStrings :: AP.Parser BS.ByteString -> LBS.ByteString -> Either String [LBS.ByteString]@@ -64,7 +67,7 @@         fail "XXX segments not read correctly"     return segs -segmentNamed :: String -> M.Map Text (Segment LC8.ByteString) -> Either String LC8.ByteString+segmentNamed :: String -> M.Map Text (Z.Segment LC8.ByteString) -> Either String LC8.ByteString segmentNamed name segments = do-  let seg = M.lookup (pack name) segments >>= (\s -> Just (s ^. L.payload))+  let seg = M.lookup (pack name) segments >>= (\s -> Just (s ^. the @"payload"))   seg & maybe (Left ("Missing segment: " ++ name)) Right

@@ -1,3 +1,5 @@+{-# LANGUAGE DeriveGeneric #-}+ module Arbor.File.Format.Asif.Type where  import Arbor.File.Format.Asif.Format   (Format)@@ -6,55 +8,56 @@ import Data.Semigroup import Data.Text                       (Text) import Data.Thyme.Clock.POSIX          (POSIXTime)+import GHC.Generics  data SegmentMeta = SegmentMeta-  { _segmentMetaCreateTime :: Maybe POSIXTime-  , _segmentMetaFilename   :: Maybe Text-  , _segmentMetaFormat     :: Maybe (Whatever Format)-  } deriving (Eq, Show)+  { createTime :: Maybe POSIXTime+  , filename   :: Maybe Text+  , format     :: Maybe (Whatever Format)+  } deriving (Eq, Show, Generic)  instance Semigroup SegmentMeta where   a <> b =  SegmentMeta-    { _segmentMetaCreateTime = _segmentMetaCreateTime a `secondJust` _segmentMetaCreateTime b-    , _segmentMetaFilename   = _segmentMetaFilename   a `secondJust` _segmentMetaFilename   b-    , _segmentMetaFormat     = _segmentMetaFormat     a `secondJust` _segmentMetaFormat     b+    { createTime = createTime a `secondJust` createTime b+    , filename   = filename   a `secondJust` filename   b+    , format     = format     a `secondJust` format     b     }  instance Monoid SegmentMeta where   mappend = (<>)   mempty = SegmentMeta-    { _segmentMetaCreateTime = Nothing-    , _segmentMetaFilename   = Nothing-    , _segmentMetaFormat     = Nothing+    { createTime = Nothing+    , filename   = Nothing+    , format     = Nothing     }  data Segment a = Segment-  { _segmentMeta    :: SegmentMeta-  , _segmentPayload :: a-  }+  { meta    :: SegmentMeta+  , payload :: a+  } deriving Generic  segment :: a -> SegmentMeta -> Segment a-segment payload meta = Segment-  { _segmentMeta      = meta-  , _segmentPayload   = payload+segment payload' meta' = Segment+  { meta      = meta'+  , payload   = payload'   }  metaCreateTime :: POSIXTime -> SegmentMeta metaCreateTime time = mempty-  { _segmentMetaCreateTime = Just time+  { createTime = Just time   }  metaFilename :: Text -> SegmentMeta metaFilename filePath = mempty-  { _segmentMetaFilename = Just filePath+  { filename = Just filePath   }  metaFormat :: Whatever Format -> SegmentMeta-metaFormat format = mempty-  { _segmentMetaFormat = Just format+metaFormat format' = mempty+  { format = Just format'   }  metaMaybeFormat :: Maybe (Whatever Format) -> SegmentMeta metaMaybeFormat maybeFormat = mempty-  { _segmentMetaFormat = maybeFormat+  { format = maybeFormat   }

@@ -1,6 +1,9 @@+{-# LANGUAGE DeriveGeneric #-}+ module Arbor.File.Format.Asif.Whatever where  import Data.Text                       (Text)+import GHC.Generics import GHC.Read import Text.ParserCombinators.ReadP    as P import Text.ParserCombinators.ReadPrec@@ -8,7 +11,7 @@ import qualified Data.Text                       as T import qualified Text.ParserCombinators.ReadPrec as R -data Whatever a = Known a | Unknown Text deriving Eq+data Whatever a = Known a | Unknown Text deriving (Eq, Generic)  instance Show a => Show (Whatever a) where   showsPrec n (Known a)   = showsPrec n a

@@ -1,21 +1,21 @@+{-# LANGUAGE DataKinds           #-} {-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeApplications    #-}  module Arbor.File.Format.Asif.ByteString.BuilderSpec   ( spec   ) where -import Arbor.File.Format.Asif.ByteString.Builder import Arbor.File.Format.Asif.Segment import Conduit import Control.Lens+import Data.Generics.Product import HaskellWorks.Hspec.Hedgehog import Hedgehog-import System.IO                                 (openTempFile)+import System.IO                      (openTempFile) import Test.Hspec -import qualified Arbor.File.Format.Asif                    as C import qualified Arbor.File.Format.Asif.ByteString.Builder as LB-import qualified Arbor.File.Format.Asif.Lens               as L import qualified Data.Attoparsec.ByteString                as AP import qualified Data.ByteString                           as BS import qualified Data.ByteString.Lazy                      as LBS@@ -58,4 +58,4 @@      let Right segments = extractSegments (AP.string "seg:wxyz") contents -    ((^. L.payload) <$> segments) === [b1, b2, b3]+    ((^. the @"payload") <$> segments) === [b1, b2, b3]

@@ -14,7 +14,6 @@  import qualified Arbor.File.Format.Asif                    as C import qualified Arbor.File.Format.Asif.ByteString.Builder as LB-import qualified Arbor.File.Format.Asif.Lens               as L import qualified Data.Attoparsec.ByteString                as AP import qualified Data.ByteString                           as BS import qualified Data.ByteString.Lazy                      as LBS