hw-dump 0.0.0.1 → 0.1.0.0
raw patch · 11 files changed
+322/−198 lines, 11 filesdep +generic-lensdep −hw-dumpdep ~QuickCheckPVP ok
version bump matches the API change (PVP)
Dependencies added: generic-lens
Dependencies removed: hw-dump
Dependency ranges changed: QuickCheck
API changes (from Hackage documentation)
Files
- app/App/Commands.hs +4/−0
- app/App/Commands/Bits.hs +30/−52
- app/App/Commands/Complement.hs +42/−0
- app/App/Commands/InterestBits.hs +89/−0
- app/App/Commands/Options/Lens.hs +0/−15
- app/App/Commands/Options/Type.hs +29/−13
- app/App/Commands/SelectedByBits.hs +9/−7
- app/App/Commands/Slice.hs +10/−8
- app/App/Commands/Words.hs +9/−7
- hw-dump.cabal +98/−95
- src/HaskellWorks/Data/Dump.hs +2/−1
app/App/Commands.hs view
@@ -1,6 +1,8 @@ module App.Commands where import App.Commands.Bits+import App.Commands.Complement+import App.Commands.InterestBits import App.Commands.SelectedByBits import App.Commands.Slice import App.Commands.Words@@ -10,6 +12,8 @@ cmdOpts :: Parser (IO ()) cmdOpts = subparser $ mempty <> cmdBits+ <> cmdComplement+ <> cmdInterestBits <> cmdSelectedByBits <> cmdSlice <> cmdWords
app/App/Commands/Bits.hs view
@@ -1,23 +1,22 @@+{-# LANGUAGE DataKinds #-} {-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeApplications #-} module App.Commands.Bits ( cmdBits ) where -import App.Commands.Options.Type import Control.Lens-import Control.Monad-import Data.Char (isAscii, isPrint)-import Data.List (transpose)+import Data.Generics.Product.Any import Data.Semigroup ((<>)) import HaskellWorks.Data.Bits.BitShow-import Numeric (showHex)+import HaskellWorks.Data.Positioning import Options.Applicative hiding (columns) -import qualified App.Commands.Options.Lens as L-import qualified Data.ByteString.Lazy as LBS-import qualified Data.ByteString.Lazy.Char8 as C8-import qualified System.IO as IO+import qualified App.Commands.Options.Type as Z+import qualified Data.ByteString.Lazy as LBS+import qualified Options.Applicative as O+import qualified System.IO as IO {-# ANN module ("HLint: ignore Redundant do" :: String) #-} {-# ANN module ("HLint: ignore Redundant return" :: String) #-}@@ -30,57 +29,36 @@ then [lbs] else [] -zap :: [a] -> [[b]] -> [(a, [b])]-zap (a:as) (b:bs) = (a, b):(zap as bs)-zap (a:as) _ = (a, []):(zap as [])-zap _ _ = []--isAsciiPrintable :: Char -> Bool-isAsciiPrintable c = isPrint c && isAscii c--maskNonAsciiPrintable :: Char -> Char-maskNonAsciiPrintable c = if isAsciiPrintable c then c else '.'+intersperseN :: a -> Count -> Count -> [a] -> [a]+intersperseN a n 0 xs = a:intersperseN a n n xs+intersperseN a n i (x:xs) = x:intersperseN a n (i - 1) xs+intersperseN _ _ _ [] = [] -runBits :: BitsOptions -> IO ()+runBits :: Z.BitsOptions -> IO () runBits opts = do- let file = opts ^. L.file- let bitFiles = opts^. L.bitFiles+ let file = opts ^. the @"file"+ let wordBits = opts ^. the @"wordBits" - chunkedContents <- lazyByteStringChunks 64 <$> LBS.readFile file- chunkedBitContents <- forM bitFiles $ (lazyByteStringChunks 8 <$>) . LBS.readFile+ chunkedContents <- lazyByteStringChunks 64 <$> LBS.readFile file - forM_ (zap (zip [0..] chunkedContents) (transpose chunkedBitContents)) $ \((i :: Int, as), bss) -> do- IO.putStr (reverse (take 8 (reverse ((("00000000" ++) . showHex i) ""))))- IO.putStr " "- let css = lazyByteStringChunks 8 as- forM_ css $ \cs -> do- IO.putStr " "- IO.putStr (maskNonAsciiPrintable <$> C8.unpack cs)- IO.putStrLn ""- forM_ bss $ \bs -> do- IO.putStr " "- forM_ (zip css (LBS.unpack bs)) $ \(cs, b) -> do- IO.putStr " "- IO.putStr $ take (fromIntegral (LBS.length cs)) (bitShow b)- IO.putStrLn ""- IO.putStrLn ""- return ()+ let xs :: String = foldl (.) id (fmap bitShows chunkedContents) "" + IO.putStrLn $ intersperseN '\n' wordBits 0 (filter (/= ' ') xs)+ return () -optsBits :: Parser BitsOptions-optsBits = BitsOptions+optsBits :: Parser Z.BitsOptions+optsBits = Z.BitsOptions <$> strOption- ( long "file"- <> help "Source file"- <> metavar "FILE"- )- <*> many- ( strOption- ( long "bit-file"- <> help "Bit file"- <> metavar "FILE"- )+ ( long "file"+ <> help "Source file"+ <> metavar "FILE"+ )+ <*> option auto+ ( long "word-bits"+ <> help "Bit file"+ <> metavar "FILE"+ <> showDefault <> O.value 8 ) cmdBits :: Mod CommandFields (IO ())
+ app/App/Commands/Complement.hs view
@@ -0,0 +1,42 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeApplications #-}++module App.Commands.Complement+ ( cmdComplement+ ) where++import Control.Lens+import Data.Generics.Product.Any+import Data.Semigroup ((<>))+import HaskellWorks.Data.Bits.BitWise+import Options.Applicative hiding (columns)++import qualified App.Commands.Options.Type as Z+import qualified Data.ByteString.Lazy as LBS++{-# ANN module ("HLint: ignore Redundant do" :: String) #-}+{-# ANN module ("HLint: ignore Redundant return" :: String) #-}++runComplement :: Z.ComplementOptions -> IO ()+runComplement opts = do+ let inputFile = opts ^. the @"inputFile"+ let outputFile = opts ^. the @"outputFile"++ LBS.readFile inputFile <&> LBS.map comp >>= LBS.writeFile outputFile++optsComplement :: Parser Z.ComplementOptions+optsComplement = Z.ComplementOptions+ <$> strOption+ ( long "input-file"+ <> help "Input file"+ <> metavar "FILE"+ )+ <*> strOption+ ( long "output-file"+ <> help "Output file"+ <> metavar "FILE"+ )++cmdComplement :: Mod CommandFields (IO ())+cmdComplement = command "complement" $ flip info idm $ runComplement <$> optsComplement
+ app/App/Commands/InterestBits.hs view
@@ -0,0 +1,89 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeApplications #-}++module App.Commands.InterestBits+ ( cmdInterestBits+ ) where++import Control.Lens+import Control.Monad+import Data.Char (isAscii, isPrint)+import Data.Generics.Product.Any+import Data.List (transpose)+import Data.Semigroup ((<>))+import HaskellWorks.Data.Bits.BitShow+import Numeric (showHex)+import Options.Applicative hiding (columns)++import qualified App.Commands.Options.Type as Z+import qualified Data.ByteString.Lazy as LBS+import qualified Data.ByteString.Lazy.Char8 as C8+import qualified System.IO as IO++{-# ANN module ("HLint: ignore Redundant do" :: String) #-}+{-# ANN module ("HLint: ignore Redundant return" :: String) #-}++lazyByteStringChunks :: Int -> LBS.ByteString -> [LBS.ByteString]+lazyByteStringChunks n bs = case LBS.splitAt (fromIntegral n) bs of+ (lbs, rbs) -> if LBS.length rbs > 0+ then lbs:lazyByteStringChunks n rbs+ else if LBS.length lbs > 0+ then [lbs]+ else []++zap :: [a] -> [[b]] -> [(a, [b])]+zap (a:as) (b:bs) = (a, b):(zap as bs)+zap (a:as) _ = (a, []):(zap as [])+zap _ _ = []++isAsciiPrintable :: Char -> Bool+isAsciiPrintable c = isPrint c && isAscii c++maskNonAsciiPrintable :: Char -> Char+maskNonAsciiPrintable c = if isAsciiPrintable c then c else '.'++runInterestBits :: Z.InterestBitsOptions -> IO ()+runInterestBits opts = do+ let file = opts ^. the @"file"+ let bitFiles = opts ^. the @"bitFiles"++ chunkedContents <- lazyByteStringChunks 64 <$> LBS.readFile file+ chunkedBitContents <- forM bitFiles $ (lazyByteStringChunks 8 <$>) . LBS.readFile++ forM_ (zap (zip [0..] chunkedContents) (transpose chunkedBitContents)) $ \((i :: Int, as), bss) -> do+ IO.putStr (reverse (take 8 (reverse ((("00000000" ++) . showHex i) ""))))+ IO.putStr " "+ let css = lazyByteStringChunks 8 as+ forM_ css $ \cs -> do+ IO.putStr " "+ IO.putStr (maskNonAsciiPrintable <$> C8.unpack cs)+ IO.putStrLn ""+ forM_ bss $ \bs -> do+ IO.putStr " "+ forM_ (zip css (LBS.unpack bs)) $ \(cs, b) -> do+ IO.putStr " "+ IO.putStr $ take (fromIntegral (LBS.length cs)) (bitShow b)+ IO.putStrLn ""+ IO.putStrLn ""+ return ()++ return ()++optsInterestBits :: Parser Z.InterestBitsOptions+optsInterestBits = Z.InterestBitsOptions+ <$> strOption+ ( long "file"+ <> help "Source file"+ <> metavar "FILE"+ )+ <*> many+ ( strOption+ ( long "bit-file"+ <> help "Bit file"+ <> metavar "FILE"+ )+ )++cmdInterestBits :: Mod CommandFields (IO ())+cmdInterestBits = command "interest-bits" $ flip info idm $ runInterestBits <$> optsInterestBits
− app/App/Commands/Options/Lens.hs
@@ -1,15 +0,0 @@-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE FunctionalDependencies #-}-{-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE TemplateHaskell #-}-{-# LANGUAGE TypeSynonymInstances #-}--module App.Commands.Options.Lens where--import App.Commands.Options.Type-import Control.Lens--makeFields ''BitsOptions-makeFields ''SelectedByBitsOptions-makeFields ''SliceOptions-makeFields ''WordsOptions
app/App/Commands/Options/Type.hs view
@@ -1,22 +1,38 @@+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE DuplicateRecordFields #-}+ module App.Commands.Options.Type where +import GHC.Generics+import HaskellWorks.Data.Positioning+ data BitsOptions = BitsOptions- { _bitsOptionsFile :: FilePath- , _bitsOptionsBitFiles :: [FilePath]- } deriving (Eq, Show)+ { file :: FilePath+ , wordBits :: Count+ } deriving (Eq, Show, Generic) +data ComplementOptions = ComplementOptions+ { inputFile :: FilePath+ , outputFile :: FilePath+ } deriving (Eq, Show, Generic)++data InterestBitsOptions = InterestBitsOptions+ { file :: FilePath+ , bitFiles :: [FilePath]+ } deriving (Eq, Show, Generic)+ data SelectedByBitsOptions = SelectedByBitsOptions- { _selectedByBitsOptionsFile :: FilePath- , _selectedByBitsOptionsBitFile :: FilePath- } deriving (Eq, Show)+ { file :: FilePath+ , bitFile :: FilePath+ } deriving (Eq, Show, Generic) data SliceOptions = SliceOptions- { _sliceOptionsFile :: FilePath- , _sliceOptionsWordSize :: Int- , _sliceOptionsWordIndex :: Int- } deriving (Eq, Show)+ { file :: FilePath+ , wordSize :: Int+ , wordIndex :: Int+ } deriving (Eq, Show, Generic) data WordsOptions = WordsOptions- { _wordsOptionsFile :: FilePath- , _wordsOptionsWordSize :: Int- } deriving (Eq, Show)+ { file :: FilePath+ , wordSize :: Int+ } deriving (Eq, Show, Generic)
app/App/Commands/SelectedByBits.hs view
@@ -1,19 +1,21 @@+{-# LANGUAGE DataKinds #-} {-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeApplications #-} module App.Commands.SelectedByBits ( cmdSelectedByBits ) where -import App.Commands.Options.Type import Control.Lens import Control.Monad import Data.Bits (countTrailingZeros)+import Data.Generics.Product.Any import Data.Semigroup ((<>)) import Data.Word import HaskellWorks.Data.Bits.BitWise import Options.Applicative hiding (columns) -import qualified App.Commands.Options.Lens as L+import qualified App.Commands.Options.Type as Z import qualified Data.ByteString as BS import qualified Data.ByteString.Builder as B import qualified Data.ByteString.Lazy as LBS@@ -34,10 +36,10 @@ go (w .&. (0xfffffffffffffffe .<. fromIntegral i)) (b <> B.word8 (BS.unsafeIndex as i)) else b -runSelectedByBits :: SelectedByBitsOptions -> IO ()+runSelectedByBits :: Z.SelectedByBitsOptions -> IO () runSelectedByBits opts = do- let file = opts ^. L.file- let bitFile = opts ^. L.bitFile+ let file = opts ^. the @"file"+ let bitFile = opts ^. the @"bitFile" chunkedContents <- LBS.toChunks . LBS.rechunkPadded 64 <$> LBS.readFile file chunkedBitContents <- LBS.toChunks . LBS.rechunkPadded 8 <$> LBS.readFile bitFile@@ -47,8 +49,8 @@ return () -optsSelectedByBits :: Parser SelectedByBitsOptions-optsSelectedByBits = SelectedByBitsOptions+optsSelectedByBits :: Parser Z.SelectedByBitsOptions+optsSelectedByBits = Z.SelectedByBitsOptions <$> strOption ( long "file" <> help "Source file"
app/App/Commands/Slice.hs view
@@ -1,19 +1,21 @@+{-# LANGUAGE DataKinds #-} {-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeApplications #-} module App.Commands.Slice ( cmdSlice ) where -import App.Commands.Options.Type import Control.Lens import Control.Monad import Data.Bits.Pext+import Data.Generics.Product.Any import Data.Semigroup ((<>)) import Data.Word import HaskellWorks.Data.Vector.AsVector64 import Options.Applicative hiding (columns) -import qualified App.Commands.Options.Lens as L+import qualified App.Commands.Options.Type as Z import qualified Data.ByteString.Builder as B import qualified Data.ByteString.Lazy as LBS import qualified Data.Vector.Storable as DVS@@ -24,11 +26,11 @@ {-# ANN module ("HLint: ignore Redundant do" :: String) #-} {-# ANN module ("HLint: ignore Redundant return" :: String) #-} -runSlice :: SliceOptions -> IO ()+runSlice :: Z.SliceOptions -> IO () runSlice opts = do- let file = opts ^. L.file- let wordIndex = opts ^. L.wordIndex- let wordSize = opts ^. L.wordSize+ let file = opts ^. the @"file"+ let wordIndex = opts ^. the @"wordIndex"+ let wordSize = opts ^. the @"wordSize" case (wordSize, wordIndex) of (2, 0) -> do@@ -47,8 +49,8 @@ return () -optsSlice :: Parser SliceOptions-optsSlice = SliceOptions+optsSlice :: Parser Z.SliceOptions+optsSlice = Z.SliceOptions <$> strOption ( long "file" <> help "Source file"
app/App/Commands/Words.hs view
@@ -1,18 +1,20 @@+{-# LANGUAGE DataKinds #-} {-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeApplications #-} module App.Commands.Words ( cmdWords ) where -import App.Commands.Options.Type import Control.Lens import Control.Monad+import Data.Generics.Product.Any import Data.Semigroup ((<>)) import Data.Word import Numeric (showHex) import Options.Applicative hiding (columns) -import qualified App.Commands.Options.Lens as L+import qualified App.Commands.Options.Type as Z import qualified Data.Vector.Storable as DVS import qualified HaskellWorks.Data.FromForeignRegion as IO import qualified System.IO as IO@@ -33,10 +35,10 @@ return () -runWords :: WordsOptions -> IO ()+runWords :: Z.WordsOptions -> IO () runWords opts = do- let file = opts ^. L.file- let wordSize = opts^. L.wordSize+ let file = opts ^. the @"file"+ let wordSize = opts ^. the @"wordSize" case wordSize of 64 -> IO.mmapFromForeignRegion file >>= printWords64@@ -44,8 +46,8 @@ return () -optsWords :: Parser WordsOptions-optsWords = WordsOptions+optsWords :: Parser Z.WordsOptions+optsWords = Z.WordsOptions <$> strOption ( long "file" <> help "Source file"
hw-dump.cabal view
@@ -1,25 +1,21 @@--- This file has been generated from package.yaml by hpack version 0.18.1.------ see: https://github.com/sol/hpack--name: hw-dump-version: 0.0.0.1-synopsis: File Dump-description: Please see README.md-category: Data, Bit-stability: Experimental-homepage: http://github.com/haskell-works/hw-dump#readme-bug-reports: https://github.com/haskell-works/hw-dump/issues-author: John Ky-maintainer: newhoggy@gmail.com-copyright: 2016 John Ky-license: BSD3-license-file: LICENSE-build-type: Simple-cabal-version: >= 1.10+cabal-version: 2.2 +name: hw-dump+version: 0.1.0.0+synopsis: File Dump+description: Please see README.md+category: Data, Bit+stability: Experimental+homepage: http://github.com/haskell-works/hw-dump#readme+bug-reports: https://github.com/haskell-works/hw-dump/issues+author: John Ky+maintainer: newhoggy@gmail.com+copyright: 2016-2019 John Ky+license: BSD-3-Clause+license-file: LICENSE+build-type: Simple extra-source-files:- README.md+ README.md source-repository head type: git@@ -30,90 +26,97 @@ manual: False default: True -library- hs-source-dirs:- src- build-depends:- base >= 4 && < 5- , bits-extra- , bytestring- , hw-bits >= 0.7.0.3- , hw-prim >= 0.6.2.19- , vector- , safe+common base { build-depends: base >= 4 && < 5 }++common QuickCheck { build-depends: QuickCheck >= 2.10 && < 2.14 }+common bits-extra { build-depends: bits-extra }+common bytestring { build-depends: bytestring }+common criterion { build-depends: criterion }+common generic-lens { build-depends: generic-lens }+common hedgehog { build-depends: hedgehog }+common hspec { build-depends: hspec }+common hw-bits { build-depends: hw-bits >= 0.7.0.3 }+common hw-hspec-hedgehog { build-depends: hw-hspec-hedgehog }+common hw-prim { build-depends: hw-prim >= 0.6.2.19 }+common lens { build-depends: lens }+common optparse-applicative { build-depends: optparse-applicative }+common safe { build-depends: safe }+common vector { build-depends: vector }++common config+ default-language: Haskell2010+ ghc-options: -Wall -Wcompat -Wincomplete-record-updates -Wincomplete-uni-patterns -Wredundant-constraints if flag(sse42)- ghc-options: -Wall -O2 -msse4.2- else- ghc-options: -Wall -O2+ ghc-options: -msse4.2++library+ import: base, config+ , bits-extra+ , bytestring+ , hw-bits+ , hw-prim+ , safe+ , vector exposed-modules:- HaskellWorks.Data.Dump- other-modules:- Paths_hw_dump- default-language: Haskell2010+ HaskellWorks.Data.Dump+ other-modules: Paths_hw_dump+ autogen-modules: Paths_hw_dump+ hs-source-dirs: src executable hw-dump- main-is: Main.hs- hs-source-dirs:- app- ghc-options: -threaded -rtsopts -with-rtsopts=-N -Wall -Wcompat -Wincomplete-record-updates -Wincomplete-uni-patterns -Wredundant-constraints -O2- build-depends:- base >= 4 && < 5- , bits-extra- , bytestring- , hw-bits >= 0.7.0.3- , hw-prim >= 0.6.2.19- , vector- , hw-dump- , lens- , optparse-applicative+ import: base, config+ , bits-extra+ , bytestring+ , generic-lens+ , hw-bits+ , hw-prim+ , lens+ , optparse-applicative+ , vector+ main-is: Main.hs+ hs-source-dirs: app+ ghc-options: -threaded -rtsopts -with-rtsopts=-N other-modules:- App.Commands- App.Commands.Bits- App.Commands.Options.Lens- App.Commands.Options.Type- App.Commands.SelectedByBits- App.Commands.Slice- App.Commands.Words- default-language: Haskell2010+ App.Commands+ App.Commands.Bits+ App.Commands.Complement+ App.Commands.InterestBits+ App.Commands.Options.Type+ App.Commands.SelectedByBits+ App.Commands.Slice+ App.Commands.Words+ Paths_hw_dump test-suite hw-dump-test- type: exitcode-stdio-1.0- main-is: Spec.hs- hs-source-dirs:- test- ghc-options: -threaded -rtsopts -with-rtsopts=-N -Wall- build-depends:- base >= 4 && < 5- , bits-extra- , bytestring- , hw-bits >= 0.7.0.3- , hw-prim >= 0.6.2.19- , vector- , hedgehog- , hspec- , hw-dump- , hw-hspec-hedgehog- , QuickCheck+ import: base, config+ , QuickCheck+ , bits-extra+ , bytestring+ , hedgehog+ , hspec+ , hw-bits+ , hw-hspec-hedgehog+ , hw-prim+ , vector+ type: exitcode-stdio-1.0+ main-is: Spec.hs+ hs-source-dirs: test+ ghc-options: -threaded -rtsopts -with-rtsopts=-N -Wall+ build-tool-depends: hspec-discover:hspec-discover other-modules: HaskellWorks.Data.Dump.DumpSpec- default-language: Haskell2010+ Paths_hw_dump benchmark bench- type: exitcode-stdio-1.0- main-is: Main.hs- hs-source-dirs:- bench+ import: base, config+ , bits-extra+ , bytestring+ , criterion+ , hw-bits+ , hw-prim+ , vector+ type: exitcode-stdio-1.0+ main-is: Main.hs+ other-modules: Paths_hw_dump+ hs-source-dirs: bench build-depends:- base >= 4 && < 5- , bits-extra- , bytestring- , hw-bits >= 0.7.0.3- , hw-prim >= 0.6.2.19- , vector- , criterion- , hw-dump- if flag(sse42)- ghc-options: -Wall -O2 -msse4.2- else- ghc-options: -Wall -O2- default-language: Haskell2010
src/HaskellWorks/Data/Dump.hs view
@@ -1,1 +1,2 @@-module HaskellWorks.Data.Dump where+module HaskellWorks.Data.Dump+ () where