Jack/compress
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity

dependency bump & fourmolu

Browse source
This commit is contained in:
Jack Wines 2024-04-15 02:58:48 -07:00
parent 110c6eb8a5
commit 5bb8afb672
No known key found for this signature in database
GPG key ID: 25B20640600571E6
5 changed files with 54 additions and 39 deletions
Download patch file Download diff file Expand all files Collapse all files

2
.gitignore vendored
View file

@ -3,3 +3,5 @@
/.direnv/
**/.DS_Store
/cabal.project.local
/compress.hp
/*.prof

30
flake.lock generated
View file

@ -5,11 +5,11 @@
"nixpkgs-lib": "nixpkgs-lib"
},
"locked": {
"lastModified": 1709336216,
"narHash": "sha256-Dt/wOWeW6Sqm11Yh+2+t0dfEWxoMxGBvv3JpIocFl9E=",
"lastModified": 1712014858,
"narHash": "sha256-sB4SWl2lX95bExY2gMFG5HIzvva5AVMJd4Igm+GpZNw=",
"owner": "hercules-ci",
"repo": "flake-parts",
"rev": "f7b3c975cf067e56e7cda6cb098ebe3fb4d74ca2",
"rev": "9126214d0a59633752a136528f5f3b9aa8565b7d",
"type": "github"
},
"original": {
@ -20,11 +20,11 @@
},
"haskell-flake": {
"locked": {
"lastModified": 1711149116,
"narHash": "sha256-tccTtjRvxrhSJkCnmNwaPrq0DDM3UsM0uiDyW4uJXXc=",
"lastModified": 1713084600,
"narHash": "sha256-qL7LV2MtwJ+1Xasg1TjSUmoE7yrRuXPqxpPlKjLE0SE=",
"owner": "srid",
"repo": "haskell-flake",
"rev": "6ae8a85071adfe08d70d9963c526947403c6c070",
"rev": "847292fc793a5c15c873e52e7751ee4267ef32a0",
"type": "github"
},
"original": {
@ -35,11 +35,11 @@
},
"nixpkgs": {
"locked": {
"lastModified": 1711163522,
"narHash": "sha256-YN/Ciidm+A0fmJPWlHBGvVkcarYWSC+s3NTPk/P+q3c=",
"lastModified": 1712963716,
"narHash": "sha256-WKm9CvgCldeIVvRz87iOMi8CFVB1apJlkUT4GGvA0iM=",
"owner": "nixos",
"repo": "nixpkgs",
"rev": "44d0940ea560dee511026a53f0e2e2cde489b4d4",
"rev": "cfd6b5fc90b15709b780a5a1619695a88505a176",
"type": "github"
},
"original": {
@ -52,11 +52,11 @@
"nixpkgs-lib": {
"locked": {
"dir": "lib",
"lastModified": 1709237383,
"narHash": "sha256-cy6ArO4k5qTx+l5o+0mL9f5fa86tYUX3ozE1S+Txlds=",
"lastModified": 1711703276,
"narHash": "sha256-iMUFArF0WCatKK6RzfUJknjem0H9m4KgorO/p3Dopkk=",
"owner": "NixOS",
"repo": "nixpkgs",
"rev": "1536926ef5621b09bba54035ae2bb6d806d72ac8",
"rev": "d8fe5e6c92d0d190646fb9f1056741a229980089",
"type": "github"
},
"original": {
@ -98,11 +98,11 @@
]
},
"locked": {
"lastModified": 1710781103,
"narHash": "sha256-nehQK/XTFxfa6rYKtbi8M1w+IU1v5twYhiyA4dg1vpg=",
"lastModified": 1711963903,
"narHash": "sha256-N3QDhoaX+paWXHbEXZapqd1r95mdshxToGowtjtYkGI=",
"owner": "numtide",
"repo": "treefmt-nix",
"rev": "7ee5aaac63c30d3c97a8c56efe89f3b2aa9ae564",
"rev": "49dc4a92b02b8e68798abd99184f228243b6e3ac",
"type": "github"
},
"original": {

2
flake.nix
View file

@ -42,7 +42,7 @@
# Development shell configuration
devShell = {
hlsCheck.enable = false;
hlsCheck.enable = true;
};
# What should haskell-flake add to flake outputs?

16
fourmolu.yaml Normal file
View file

@ -0,0 +1,16 @@
# Generated from web app, for more information, see: https://fourmolu.github.io/config/
indentation: 4
column-limit: none
function-arrows: leading
comma-style: trailing
import-export-style: diff-friendly
indent-wheres: false
record-brace-space: true
newlines-between-decls: 1
haddock-style: multi-line
haddock-style-module: single-line
let-style: auto
in-style: right-align
single-constraint-parens: always
unicode: never
respectful: false

25
src/Main.hs
View file

@ -25,16 +25,14 @@ import System.Environment qualified as SE
data HuffmanTree a
= Leaf a
| Node
{ left :: HuffmanTree a
, right :: HuffmanTree a
}
{left :: HuffmanTree a, right :: HuffmanTree a}
deriving (Eq, Ord, Show, Generic, C.Serialize)
data TreeDir = L | R deriving (Eq, Ord, Show, Generic, C.Serialize)
findTreeDirections :: forall a. (Ord a) => HuffmanTree a -> M.Map a [TreeDir]
findTreeDirections (Leaf a) = M.singleton a []
findTreeDirections (Node{..}) = M.union (rec' L left) (rec' R right)
findTreeDirections (Node {..}) = M.union (rec' L left) (rec' R right)
where
rec' :: TreeDir -> HuffmanTree a -> M.Map a [TreeDir]
rec' dir = M.map (dir :) . findTreeDirections
@ -43,7 +41,6 @@ decompress :: forall a. (Ord a, Integral a, B.FiniteBits a) => Maybe ([TreeDir],
decompress Nothing = Just []
decompress (Just (treeDirs, tree)) = decompress' treeDirs
where
decompress' :: [TreeDir] -> Maybe [a]
decompress' [] = Just []
decompress' xs = case nextLeaf xs tree of
@ -53,8 +50,8 @@ decompress (Just (treeDirs, tree)) = decompress' treeDirs
nextLeaf :: [TreeDir] -> HuffmanTree a -> Maybe (a, [TreeDir])
nextLeaf xs (Leaf a) = Just (a, xs)
nextLeaf [] _ = Nothing
nextLeaf (L:xs) (Node {..}) = nextLeaf xs left
nextLeaf (R:xs) (Node {..}) = nextLeaf xs right
nextLeaf (L : xs) (Node {..}) = nextLeaf xs left
nextLeaf (R : xs) (Node {..}) = nextLeaf xs right
compress :: forall a. (Ord a, Integral a, B.FiniteBits a) => BS.ByteString -> Maybe ([TreeDir], HuffmanTree a)
compress bs =
@ -77,7 +74,7 @@ compress bs =
testCompression :: forall a. (Ord a, Eq a, Integral a, B.FiniteBits a) => D.Proxy a -> BS.ByteString -> Bool
testCompression _ bs = ((Just . toBitsList $ bs) :: Maybe [a]) == (decompress . compress $ bs)
encodeCompressed :: C.Serialize a => Maybe ([TreeDir], HuffmanTree a) -> BS.ByteString
encodeCompressed :: (C.Serialize a) => Maybe ([TreeDir], HuffmanTree a) -> BS.ByteString
encodeCompressed = C.encode . fmap (Bi.first encodeTreeDirs)
where
encodeTreeDirs = BV.cloneToByteString . V.fromList . map (BV.Bit . (== R))
@ -122,12 +119,12 @@ finiteBitUncons bs =
rest :: BS.ByteString
(takenBytes, rest) = BS.splitAt numBytes bs
compressionRatioFor ::
forall a.
(Integral a, B.FiniteBits a, Ord a, C.Serialize a) =>
D.Proxy a ->
BS.ByteString ->
Double
compressionRatioFor
:: forall a
. (Integral a, B.FiniteBits a, Ord a, C.Serialize a)
=> D.Proxy a
-> BS.ByteString
-> Double
compressionRatioFor proxy bs =
(/ (fromIntegral . BS.length $ bs))
. fromIntegral