Add Encode typeclass

This commit is contained in:
Alexander Kobjolke 2023-10-17 15:27:39 +02:00
parent 5d02a9e424
commit 6dc02d4d3a
8 changed files with 214 additions and 16 deletions

View file

@ -1,6 +1,6 @@
module Main (main) where
import FilePack (greet)
import FilePack (filepack)
main :: IO ()
main = greet "Hello, World!"
main = filepack

View file

@ -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

View file

@ -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

View file

@ -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
View 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
View 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
View 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
View file

@ -0,0 +1 @@
{-# OPTIONS_GHC -F -pgmF hspec-discover #-}