basen (empty) → 0.1.0.0
raw patch · 8 files changed
+304/−0 lines, 8 filesdep +basedep +basendep +bytestringsetup-changed
Dependencies added: base, basen, bytestring, quickcheck-instances, tasty, tasty-discover, tasty-hspec, tasty-quickcheck, text
Files
- README.md +0/−0
- Setup.hs +2/−0
- app/Main.hs +4/−0
- basen.cabal +73/−0
- src/Data/BaseN.hs +85/−0
- src/Data/BaseN/Internal.hs +94/−0
- test/Data/BaseNTest.hs +45/−0
- test/TestSuite.hs +1/−0
+ README.md view
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ app/Main.hs view
@@ -0,0 +1,4 @@+module Main where++main :: IO ()+main = putStrLn "Hello"
+ basen.cabal view
@@ -0,0 +1,73 @@+cabal-version: 1.12++-- This file has been generated from package.yaml by hpack version 0.32.0.+--+-- see: https://github.com/sol/hpack+--+-- hash: 772b5ccd7340e4cef1a9359bf9d2277864b33bfa7ee361078619966a6badc415++name: basen+version: 0.1.0.0+description: Please see the README+homepage: https://github.com/LibreCybernetics/basen-hs#readme+bug-reports: https://github.com/LibreCybernetics/basen-hs/issues+author: LibreCybernetics+maintainer: LibreCybernetics+license: OtherLicense+build-type: Simple+extra-source-files:+ README.md++source-repository head+ type: git+ location: https://github.com/LibreCybernetics/basen-hs++library+ exposed-modules:+ Data.BaseN+ Data.BaseN.Internal+ other-modules:+ Paths_basen+ hs-source-dirs:+ src+ ghc-options: -Wall+ build-depends:+ base >=4.12.0.0 && <5+ , bytestring >=0.10.8.2 && <1+ , text >=1.2.3.1 && <2+ default-language: Haskell2010++executable basen-app+ main-is: Main.hs+ other-modules:+ Paths_basen+ hs-source-dirs:+ app+ ghc-options: -Wall -threaded -rtsopts -with-rtsopts=-N+ build-depends:+ base >=4.12.0.0 && <5+ , basen+ , bytestring >=0.10.8.2 && <1+ , text >=1.2.3.1 && <2+ default-language: Haskell2010++test-suite basen-test+ type: exitcode-stdio-1.0+ main-is: TestSuite.hs+ other-modules:+ Data.BaseNTest+ Paths_basen+ hs-source-dirs:+ test+ ghc-options: -Wall -threaded -rtsopts -with-rtsopts=-N+ build-depends:+ base >=4.12.0.0 && <5+ , basen+ , bytestring >=0.10.8.2 && <1+ , quickcheck-instances+ , tasty+ , tasty-discover+ , tasty-hspec+ , tasty-quickcheck+ , text >=1.2.3.1 && <2+ default-language: Haskell2010
+ src/Data/BaseN.hs view
@@ -0,0 +1,85 @@+{-# LANGUAGE FlexibleInstances #-}++module Data.BaseN (+ Base(..), DecodeError(..),+ encodeBaseN, decodeBaseN,+ encodeBase2, decodeBase2+) where++import Data.BaseN.Internal++import Prelude hiding (concat, length, seq, tail, take)++import Data.Bits+import Data.Word++import qualified Data.List as L+import qualified Data.String as S++--+-- Type Classes / Data Types+--++data Base = Base2 deriving (Eq, Show)+data DecodeError = UnkownAlphabet | WrongLength Int deriving (Eq, Show)++--+-- Constants+--++base2Alphabet = ['0', '1']+base8Alphabet = ['0'..'7']+base16Alphabet = ['0'..'9'] <> ['a'..'f']++--+-- Functions+--++encodeBase2 :: (ByteStringLike b, StringLike s) => b -> s+encodeBase2 = (`encodeBaseN` Base2)++decodeBase2 :: (StringLike s, ByteStringLike b) => s -> Either DecodeError b+decodeBase2 = (`decodeBaseN` Base2)++encodeBaseN :: (ByteStringLike b, StringLike s) => b -> Base -> s+encodeBaseN seq base = case base of+ Base2 -> seq `encodeBase2N` 2++decodeBaseN :: (StringLike s, ByteStringLike b) => s -> Base -> Either DecodeError b+decodeBaseN seq base = case base of+ Base2 -> seq `decodeBase2N` 2++--+-- Helper function+--++encodeBase2N :: (ByteStringLike b, StringLike s) => b -> Int -> s+encodeBase2N seq base = concat+ [S.fromString [base2Alphabet L.!! val | val <- chunk] | chunk <- encodeBase2N' seq base]++encodeBase2N' :: (ByteStringLike b) => b -> Int -> [[Int]]+encodeBase2N' seq base = case uncons seq of+ Just (h, seq') -> case base of+ 2 -> [if h `testBit` i then 1 else 0 | i <- [7,6..0] :: [Int]] : encodeBase2N' seq' base+ _ -> undefined+ Nothing -> []++decodeBase2N :: (StringLike s, ByteStringLike b) => s -> Int -> Either DecodeError b+decodeBase2N seq base = case base of+ 2 | lenDivBy 8 -> decodeBase2N' (seq `inChunksOf` 8) 2+ | otherwise -> Left . WrongLength $ 8 - (length seq `mod` 8)+ _ -> undefined+ where lenDivBy d = length seq `rem` d == 0++decodeBase2N' :: (StringLike s, ByteStringLike b) => [s] -> Int -> Either DecodeError b+decodeBase2N' [] _ = Right empty+decodeBase2N' (cnk:t) base = case base of+ 2 -> do+ val <- attemptSum [positionValue base base2Alphabet vals | vals <- zip (toString cnk) [7,6..0]] <?> UnkownAlphabet+ tail <- decodeBase2N' t base+ Right $ cons val tail+ _ -> undefined++attemptSum :: [Maybe Int] -> Maybe Word8+attemptSum l = fromIntegral . sum <$> sequence l+positionValue base baseAlphabet (v, e) = (* base^e) <$> L.elemIndex v baseAlphabet
+ src/Data/BaseN/Internal.hs view
@@ -0,0 +1,94 @@+{-# LANGUAGE FlexibleInstances #-}++module Data.BaseN.Internal where++import Data.Word++import Prelude hiding (drop, length, take)++import qualified Data.ByteString as BS+import qualified Data.ByteString.Lazy as LBS+import qualified Data.List as L+import qualified Data.String as S+import qualified Data.Text as T++--+-- Type Classes+--++-- ByteStringLike++class ByteStringLike b where+ cons :: Word8 -> b -> b+ empty :: b+ null :: b -> Bool+ uncons :: b -> Maybe (Word8, b)+ (!!) :: Integral i => b -> i -> Maybe Word8++instance ByteStringLike [Word8] where+ cons = (:)+ empty = []+ null = L.null+ uncons = L.uncons+ l !! i | i `boundedBy` L.length l = Just (l L.!! fromIntegral i)+ | otherwise = Nothing++instance ByteStringLike BS.ByteString where+ cons = BS.cons+ empty = BS.empty+ null = BS.null+ uncons = BS.uncons+ bs !! i | i `boundedBy` BS.length bs = Just (bs `BS.index` fromIntegral i)+ | otherwise = Nothing++instance ByteStringLike LBS.ByteString where+ cons = LBS.cons+ empty = LBS.empty+ null = LBS.null+ uncons = LBS.uncons+ bs !! i | i `boundedBy` LBS.length bs = Just(bs `LBS.index` fromIntegral i)+ | otherwise = Nothing++-- StringLike++class S.IsString s => StringLike s where+ concat :: [s] -> s+ drop :: Int -> s -> s+ length :: s -> Int+ take :: Int -> s -> s+ toString :: s -> String++instance StringLike String where+ concat = L.concat+ drop = L.drop+ length = L.length+ take = L.take+ toString = id++instance StringLike T.Text where+ concat = T.concat+ drop = T.drop+ length = T.length+ take = T.take+ toString = T.unpack++--+-- Helper Functions+--++-- | Bounded between 0 and a given i. [0, i)+boundedBy :: (Integral idx, Integral len) => idx -> len -> Bool+idx `boundedBy` len = 0 <= idx' && idx' < len+ where idx' = fromIntegral idx++inChunksOf :: StringLike s => s -> Int -> [s]+s `inChunksOf` n | length s > n = take n s : (drop n s `inChunksOf` n)+ | length s > 0 = [s]+ | otherwise = []+++-- Taken from: https://github.com/pmlodawski/error-util+-- License: MIT+infixl 4 <?>+(<?>) :: Maybe b -> a -> Either a b+val <?> m = maybe (Left m) Right val
+ test/Data/BaseNTest.hs view
@@ -0,0 +1,45 @@+module Data.BaseNTest where++import Test.Tasty.Hspec+import Test.Tasty.QuickCheck+import Test.QuickCheck.Instances.ByteString ()++import Data.BaseN++import Data.ByteString+import Data.Word++--+-- Specs+--++spec_examples :: Spec+spec_examples = do+ describe "Edge Cases" $ do+ it "Empty Base2" $ do+ encodeBase2 ([] :: [Word8]) `shouldBe` ""+ decodeBase2 "" `shouldBe` Right ([] :: [Word8])+ it "Malformed Base2" $ do+ decodeBase2 "0" `shouldBe` (Left (WrongLength 7) :: Either DecodeError [Word8])+ decodeBase2 "000011110000" `shouldBe`(Left (WrongLength 4) :: Either DecodeError [Word8])+ decodeBase2 "01234567" `shouldBe` (Left UnkownAlphabet :: Either DecodeError [Word8])+ describe "Base2 Spec" $ do+ testEnc2 [0] "00000000"+ testEnc2 [1] "00000001"+ testEnc2 [10] "00001010"+ testEnc2 [123] "01111011"+ testEnc2 [0,0] "0000000000000000"+ testEnc2 [213,231] "1101010111100111"+ where+ testEnc2 i s = it (show i) $ encodeBase2 (i :: [Word8]) `shouldBe` s++--+-- Properties+--++prop_decodeBase2IsLeftInverseOfencodeBase2 :: ByteString -> Bool+prop_decodeBase2IsLeftInverseOfencodeBase2 input =+ decodeBase2 encoded == Right input+ where+ encoded :: String+ encoded = encodeBase2 input
+ test/TestSuite.hs view
@@ -0,0 +1,1 @@+{-# OPTIONS_GHC -F -pgmF tasty-discover #-}