Add Encode typeclass
This commit is contained in:
parent
5d02a9e424
commit
6dc02d4d3a
8 changed files with 214 additions and 16 deletions
|
|
@ -1,6 +1,6 @@
|
|||
module Main (main) where
|
||||
|
||||
import FilePack (greet)
|
||||
import FilePack (filepack)
|
||||
|
||||
main :: IO ()
|
||||
main = greet "Hello, World!"
|
||||
main = filepack
|
||||
|
|
|
|||
|
|
@ -17,13 +17,23 @@ extra-source-files:
|
|||
library
|
||||
exposed-modules:
|
||||
FilePack
|
||||
FilePack.Encode
|
||||
FilePack.FileData
|
||||
other-modules:
|
||||
Paths_filepack
|
||||
hs-source-dirs:
|
||||
src
|
||||
ghc-options: -Wall
|
||||
default-extensions:
|
||||
BlockArguments
|
||||
OverloadedStrings
|
||||
ImportQualifiedPost
|
||||
ghc-options: -Wall -fdefer-typed-holes
|
||||
build-depends:
|
||||
base >=4.13 && <5
|
||||
base
|
||||
, base64-bytestring
|
||||
, bytestring
|
||||
, text
|
||||
, unix
|
||||
default-language: GHC2021
|
||||
|
||||
executable filepack
|
||||
|
|
@ -32,8 +42,66 @@ executable filepack
|
|||
Paths_filepack
|
||||
hs-source-dirs:
|
||||
app
|
||||
ghc-options: -Wall
|
||||
default-extensions:
|
||||
BlockArguments
|
||||
OverloadedStrings
|
||||
ImportQualifiedPost
|
||||
ghc-options: -Wall -fdefer-typed-holes
|
||||
build-depends:
|
||||
base >=4.13 && <5
|
||||
base
|
||||
, base64-bytestring
|
||||
, bytestring
|
||||
, filepack
|
||||
, text
|
||||
, unix
|
||||
default-language: GHC2021
|
||||
|
||||
test-suite doctest
|
||||
type: exitcode-stdio-1.0
|
||||
main-is: Doctest.hs
|
||||
other-modules:
|
||||
Paths_filepack
|
||||
hs-source-dirs:
|
||||
test/doctest
|
||||
default-extensions:
|
||||
BlockArguments
|
||||
OverloadedStrings
|
||||
ImportQualifiedPost
|
||||
ghc-options: -Wall -fdefer-typed-holes
|
||||
build-tool-depends:
|
||||
doctest:doctest
|
||||
build-depends:
|
||||
base
|
||||
, base64-bytestring
|
||||
, bytestring
|
||||
, process
|
||||
, text
|
||||
, unix
|
||||
default-language: Haskell2010
|
||||
|
||||
test-suite spec
|
||||
type: exitcode-stdio-1.0
|
||||
main-is: Spec.hs
|
||||
other-modules:
|
||||
Paths_filepack
|
||||
hs-source-dirs:
|
||||
test/spec
|
||||
default-extensions:
|
||||
BlockArguments
|
||||
OverloadedStrings
|
||||
ImportQualifiedPost
|
||||
ghc-options: -Wall -fdefer-typed-holes
|
||||
cpp-options: -DTEST
|
||||
build-tool-depends:
|
||||
hspec-discover:hspec-discover
|
||||
build-depends:
|
||||
QuickCheck
|
||||
, base
|
||||
, base64-bytestring
|
||||
, bytestring
|
||||
, filepack
|
||||
, hspec
|
||||
, quickcheck-instances
|
||||
, text
|
||||
, unix
|
||||
default-language: GHC2021
|
||||
|
|
|
|||
35
package.yaml
35
package.yaml
|
|
@ -9,10 +9,20 @@ extra-source-files:
|
|||
- README.org
|
||||
|
||||
dependencies:
|
||||
- base >= 4.13 && < 5
|
||||
- base
|
||||
- unix
|
||||
- text
|
||||
- bytestring
|
||||
- base64-bytestring
|
||||
|
||||
ghc-options:
|
||||
- -Wall
|
||||
- -fdefer-typed-holes
|
||||
|
||||
default-extensions:
|
||||
- BlockArguments
|
||||
- OverloadedStrings
|
||||
- ImportQualifiedPost
|
||||
|
||||
library:
|
||||
source-dirs: src
|
||||
|
|
@ -27,3 +37,26 @@ executables:
|
|||
- filepack
|
||||
verbatim:
|
||||
default-language: GHC2021
|
||||
|
||||
tests:
|
||||
spec:
|
||||
cpp-options: -DTEST
|
||||
main: Spec.hs
|
||||
source-dirs:
|
||||
- test/spec
|
||||
dependencies:
|
||||
- filepack
|
||||
- hspec
|
||||
- QuickCheck
|
||||
- quickcheck-instances
|
||||
# - quickcheck-text
|
||||
build-tools: hspec-discover
|
||||
verbatim:
|
||||
default-language: GHC2021
|
||||
doctest:
|
||||
main: Doctest.hs
|
||||
source-dirs:
|
||||
- test/doctest
|
||||
dependencies:
|
||||
- process
|
||||
build-tools: doctest
|
||||
|
|
|
|||
|
|
@ -1,11 +1,6 @@
|
|||
module FilePack (
|
||||
greet,
|
||||
) where
|
||||
module FilePack where
|
||||
|
||||
import Control.Monad.IO.Class (
|
||||
MonadIO,
|
||||
liftIO,
|
||||
)
|
||||
import FilePack.FileData
|
||||
|
||||
greet :: MonadIO m => String -> m ()
|
||||
greet = liftIO <$> putStrLn
|
||||
filepack :: IO ()
|
||||
filepack = putStrLn "filepack"
|
||||
|
|
|
|||
49
src/FilePack/Encode.hs
Normal file
49
src/FilePack/Encode.hs
Normal file
|
|
@ -0,0 +1,49 @@
|
|||
module FilePack.Encode where
|
||||
|
||||
import Data.Bits (Bits (shift), (.&.))
|
||||
import Data.ByteString (ByteString)
|
||||
import Data.ByteString qualified as BS
|
||||
import Data.ByteString.Char8 qualified as BC
|
||||
import Data.Text (Text)
|
||||
import Data.Text.Encoding (encodeUtf8)
|
||||
import Data.Word (Word32, Word8)
|
||||
|
||||
class Encode a where
|
||||
encode :: a -> ByteString
|
||||
|
||||
instance Encode ByteString where
|
||||
encode = id
|
||||
|
||||
instance Encode Text where
|
||||
encode = encodeUtf8
|
||||
|
||||
instance Encode String where
|
||||
encode = BC.pack
|
||||
|
||||
type Byte = Word8
|
||||
|
||||
{- | @word32ToBytes@ splits a 32bit word into its 4 byte components.
|
||||
|
||||
>>> word32ToBytes 0xdeadbeef
|
||||
(222,173,190,239)
|
||||
-}
|
||||
word32ToBytes :: Word32 -> (Byte, Byte, Byte, Byte)
|
||||
word32ToBytes word = (a, b, c, d)
|
||||
where
|
||||
!a = fromIntegral $ (word .&. 0xff000000) `shift` (-24)
|
||||
!b = fromIntegral $ (word .&. 0x00ff0000) `shift` (-16)
|
||||
!c = fromIntegral $ (word .&. 0x0000ff00) `shift` (-8)
|
||||
!d = fromIntegral $ (word .&. 0x000000ff) `shift` (-0)
|
||||
|
||||
{- | @word32ToByteString@ encodes a 32-bit wide word into a bytestring.
|
||||
|
||||
>>> word32ToByteString 0xdeadbeef
|
||||
"\222\173\190\239"
|
||||
-}
|
||||
word32ToByteString :: Word32 -> ByteString
|
||||
word32ToByteString word =
|
||||
let (a, b, c, d) = word32ToBytes word
|
||||
in BS.pack [a, b, c, d]
|
||||
|
||||
instance Encode Word32 where
|
||||
encode = word32ToByteString
|
||||
42
src/FilePack/FileData.hs
Normal file
42
src/FilePack/FileData.hs
Normal file
|
|
@ -0,0 +1,42 @@
|
|||
module FilePack.FileData where
|
||||
|
||||
import Data.ByteString (ByteString)
|
||||
|
||||
import Data.Text (Text)
|
||||
|
||||
import Data.ByteString.Base64 qualified as B64
|
||||
import Data.ByteString.Char8 qualified as BC
|
||||
import GHC.Natural (Natural)
|
||||
import System.Posix.Types (CMode (..), FileMode)
|
||||
import Text.Read (readEither)
|
||||
|
||||
import FilePack.Encode ()
|
||||
|
||||
data FileData = FileData
|
||||
{ fileName :: Text
|
||||
, fileSize :: Natural
|
||||
, filePermissions :: FileMode
|
||||
, fileData :: ByteString
|
||||
}
|
||||
deriving (Eq, Read, Show)
|
||||
|
||||
newtype FilePack = FilePack {getPackedFiles :: [FileData]}
|
||||
deriving (Eq, Read, Show)
|
||||
|
||||
{- | @packFiles@ takes a FilePack and encodes it into a serialized form.
|
||||
|
||||
>>> import Data.Text qualified as T
|
||||
>>> import Data.ByteString qualified as BS
|
||||
>>> import System.Posix.Files (stdFileMode)
|
||||
>>> let sampleFileData = FileData{fileName=T.pack "foo.txt", fileSize = 1024, filePermissions = stdFileMode, fileData = BS.empty}
|
||||
>>> let sampleFilePack = FilePack [sampleFileData]
|
||||
>>> (Right sampleFilePack) == (unpackFiles . packFiles $ sampleFilePack)
|
||||
True
|
||||
-}
|
||||
packFiles :: FilePack -> ByteString
|
||||
packFiles = B64.encode . BC.pack . show
|
||||
|
||||
-- | @unpackFiles@ tries to recover a FilePack from its serialized form.
|
||||
unpackFiles :: ByteString -> Either String FilePack
|
||||
unpackFiles serializedData =
|
||||
B64.decode serializedData >>= readEither . BC.unpack
|
||||
10
test/doctest/Doctest.hs
Normal file
10
test/doctest/Doctest.hs
Normal file
|
|
@ -0,0 +1,10 @@
|
|||
-- | Rn the doctest executable
|
||||
module Main where
|
||||
|
||||
import System.Process (callProcess)
|
||||
|
||||
doctest :: [String] -> IO ()
|
||||
doctest = callProcess "doctest"
|
||||
|
||||
main :: IO ()
|
||||
main = doctest ["--fast", "src"]
|
||||
1
test/spec/Spec.hs
Normal file
1
test/spec/Spec.hs
Normal file
|
|
@ -0,0 +1 @@
|
|||
{-# OPTIONS_GHC -F -pgmF hspec-discover #-}
|
||||
Loading…
Add table
Add a link
Reference in a new issue