packages feed

ascii-string (empty) → 1

raw patch · 7 files changed

+428/−0 lines, 7 filesdep +QuickCheckdep +ascii-stringdep +basesetup-changed

Dependencies added: QuickCheck, ascii-string, base, bytestring, cereal, deferred-folds, foldl, hashable, primitive, primitive-extras, quickcheck-instances, rerebase, tasty, tasty-hunit, tasty-quickcheck

Files

+ LICENSE view
@@ -0,0 +1,22 @@+Copyright (c) 2017, Nikita Volkov++Permission is hereby granted, free of charge, to any person+obtaining a copy of this software and associated documentation+files (the "Software"), to deal in the Software without+restriction, including without limitation the rights to use,+copy, modify, merge, publish, distribute, sublicense, and/or sell+copies of the Software, and to permit persons to whom the+Software is furnished to do so, subject to the following+conditions:++The above copyright notice and this permission notice shall be+included in all copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,+EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES+OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND+NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT+HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,+WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING+FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR+OTHER DEALINGS IN THE SOFTWARE.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ ascii-string.cabal view
@@ -0,0 +1,70 @@+name:+  ascii-string+version:+  1+synopsis:+  Compact representation of ASCII strings+description:+  ASCII strings stored using just 7 bits per character.+  Compared to ByteString, this saves you a whole byte per 8 characters.+homepage:+  https://github.com/metrix-ai/ascii-string +bug-reports:+  https://github.com/metrix-ai/ascii-string/issues +author:+  Nikita Volkov <nikita.y.volkov@mail.ru>+maintainer:+  Metrix.AI Ninjas <ninjas@metrix.ai>+copyright:+  (c) 2018, Metrix.AI+license:+  MIT+license-file:+  LICENSE+build-type:+  Simple+cabal-version:+  >=1.10++library+  hs-source-dirs:+    library+  default-extensions:+    Arrows, BangPatterns, ConstraintKinds, DataKinds, DefaultSignatures, DeriveDataTypeable, DeriveFoldable, DeriveFunctor, DeriveGeneric, DeriveTraversable, EmptyDataDecls, FlexibleContexts, FlexibleInstances, FunctionalDependencies, GADTs, GeneralizedNewtypeDeriving, LambdaCase, LiberalTypeSynonyms, MagicHash, MultiParamTypeClasses, MultiWayIf, NoImplicitPrelude, NoMonomorphismRestriction, OverloadedStrings, PatternGuards, ParallelListComp, QuasiQuotes, RankNTypes, RecordWildCards, ScopedTypeVariables, StandaloneDeriving, TemplateHaskell, TupleSections, TypeFamilies, TypeOperators, UnboxedTuples+  default-language:+    Haskell2010+  exposed-modules:+    AsciiString+  other-modules:+    AsciiString.Prelude+    AsciiString.FoldMs+  build-depends:+    base >=4.7 && <5,+    bytestring >=0.10 && <0.11,+    cereal >=0.5.5 && <0.6,+    deferred-folds >=0.6.11 && <0.7,+    foldl >=1.4 && <2,+    hashable >=1.2.7 && <2,+    primitive >=0.6.4 && <0.7,+    primitive-extras >=0.6.3 && <0.7++test-suite test+  type:+    exitcode-stdio-1.0+  hs-source-dirs:+    test+  default-extensions:+    Arrows, BangPatterns, ConstraintKinds, DataKinds, DefaultSignatures, DeriveDataTypeable, DeriveFoldable, DeriveFunctor, DeriveGeneric, DeriveTraversable, EmptyDataDecls, FlexibleContexts, FlexibleInstances, FunctionalDependencies, GADTs, GeneralizedNewtypeDeriving, LambdaCase, LiberalTypeSynonyms, MagicHash, MultiParamTypeClasses, MultiWayIf, NoImplicitPrelude, NoMonomorphismRestriction, OverloadedStrings, PatternGuards, ParallelListComp, QuasiQuotes, RankNTypes, RecordWildCards, ScopedTypeVariables, StandaloneDeriving, TemplateHaskell, TupleSections, TypeFamilies, TypeOperators, UnboxedTuples+  default-language:+    Haskell2010+  main-is:+    Main.hs+  build-depends:+    ascii-string,+    cereal,+    QuickCheck >=2.8.1 && <3,+    quickcheck-instances >=0.3.11 && <0.4,+    rerebase <2,+    tasty >=0.12 && <2,+    tasty-hunit >=0.9 && <0.11,+    tasty-quickcheck >=0.9 && <0.11
+ library/AsciiString.hs view
@@ -0,0 +1,104 @@+module AsciiString+(+  AsciiString,+  length,+  fromSeptetList,+  fromByteString,+  fromShortByteString,+  toSeptetList,+  toByteString,+  toShortByteString,+)+where++import AsciiString.Prelude hiding (length)+import qualified Data.List as List+import qualified Data.ByteString as ByteString+import qualified Data.ByteString.Short.Internal as ShortByteString+import qualified DeferredFolds.UnfoldM as UnfoldM+import qualified AsciiString.FoldMs as FoldMs+import qualified Control.Foldl as Foldl+import qualified PrimitiveExtras.PrimArray as PrimArray+import qualified Data.Serialize as Serialize+++{-|+Compact representation of ASCII string.+-}+data AsciiString = AsciiString {-# UNPACK #-} !Int {-# UNPACK #-} !(PrimArray Word8)++deriving instance Eq AsciiString+deriving instance Ord AsciiString+deriving instance Generic AsciiString++instance Hashable AsciiString where+  hashWithSalt salt (AsciiString size (PrimArray ba)) =+    hashByteArrayWithSalt ba 0 size salt++instance Show AsciiString where+  show = show . toByteString++instance IsString AsciiString where+  fromString = fromSeptetList . fmap (fromIntegral . ord)++instance Serialize AsciiString where+  put (AsciiString size (PrimArray ba)) = do+    Serialize.put size+    Serialize.putShortByteString (ShortByteString.SBS ba)+  get = do+    septetsAmount <- Serialize.get+    let octetsAmount = div ((septetsAmount + 1) * 7) 8+    ShortByteString.SBS ba <- Serialize.getShortByteString octetsAmount+    return (AsciiString septetsAmount (PrimArray ba))+++{-| Get the amount of septets. -}+length :: AsciiString -> Int+length (AsciiString length _) = length++{-| Construct from a list of septets encoded in 'Word8', ignoring the 8th bit. -}+fromSeptetList :: [Word8] -> AsciiString+fromSeptetList list = +  fromUnfoldM (List.length list) (UnfoldM.foldable list)++{-|+Convert from ByteString, ignoring each 8th bit in it.+-}+fromByteString :: ByteString -> AsciiString+fromByteString byteString = +  fromUnfoldM (ByteString.length byteString) (UnfoldM.byteStringBytes byteString)++{-|+Convert from ShortByteString, ignoring each 8th bit in it.+-}+fromShortByteString :: ShortByteString -> AsciiString+fromShortByteString byteString =+  fromUnfoldM (ShortByteString.length byteString) (UnfoldM.shortByteStringBytes byteString)++{-# INLINE fromUnfoldM #-}+fromUnfoldM :: Int -> UnfoldM IO Word8 -> AsciiString+fromUnfoldM size unfoldM =+  AsciiString size (unsafeDupablePerformIO (UnfoldM.foldM (FoldMs.sizedSeptetPrimArrayFromSeptets size) unfoldM))++{-| Convert to a list of septets represented by 'Word8' with the 8th bit always empty. -}+toSeptetList :: AsciiString -> [Word8]+toSeptetList = unsafeDupablePerformIO . UnfoldM.foldM (Foldl.generalize Foldl.list) . toOctetUnfoldM++{-| Convert to bytestring. -}+toByteString :: AsciiString -> ByteString+toByteString = unsafeDupablePerformIO . runSizedFoldM FoldMs.sizedByteStringFromOctets++{-| Convert to short bytestring. -}+toShortByteString :: AsciiString -> ShortByteString+toShortByteString = primArraySBS . unsafeDupablePerformIO . runSizedFoldM PrimArray.elementsFoldM where+  primArraySBS :: PrimArray Word8 -> ShortByteString+  primArraySBS (PrimArray ba) = ShortByteString.SBS ba++toOctetUnfoldM :: AsciiString -> UnfoldM IO Word8+toOctetUnfoldM (AsciiString size pa) = let+  takeLast = rem (7 * succ size) 8 /= 0+  in UnfoldM.mapFoldMInput (FoldMs.overSeptets takeLast) (UnfoldM.primArray pa)++runSizedFoldM :: (Int -> FoldM IO Word8 output) -> AsciiString -> IO output+runSizedFoldM fold asciiString =+  UnfoldM.foldM (fold (length asciiString)) (toOctetUnfoldM asciiString)
+ library/AsciiString/FoldMs.hs view
@@ -0,0 +1,67 @@+module AsciiString.FoldMs+where++import AsciiString.Prelude+import qualified Data.ByteString.Internal as ByteString+++{-|+Converts a fold over septets (still encoded in octets) into a fold over actual octets.+-}+overSeptets :: Monad m => Bool -> FoldM m Word8 x -> FoldM m Word8 x+overSeptets takeLast (FoldM septStep septInit septExtract) = FoldM octStep octInit octExtract where+  octInit = Product3 0 0 <$> septInit+  octStep (Product3 unconsumedBitsAmount unconsumedOctet septState) octet =+    case unconsumedBitsAmount of+      0 -> Product3 1 (unsafeShiftR octet 7) <$> septStep septState (clearBit octet 7)+      6 -> Product3 7 (unsafeShiftR octet 1) <$> septStep septState (unconsumedOctet .|. unsafeShiftR (unsafeShiftL octet 7) 1)+      7 -> Product3 1 (unsafeShiftR octet 7) <$> septStepTwice unconsumedOctet (clearBit octet 7)+      _ -> let+        bitsToConsume = 7 - unconsumedBitsAmount+        newUnconsumedBitsAmount = 8 - bitsToConsume+        newUnconsumedOctet = unsafeShiftR octet bitsToConsume+        septet = clearBit (unconsumedOctet .|. unsafeShiftL octet unconsumedBitsAmount) 7+        in Product3 newUnconsumedBitsAmount newUnconsumedOctet <$> septStep septState septet+    where+      septStepTwice septet1 septet2 = do+        state1 <- septStep septState septet1+        septStep state1 septet2+  octExtract (Product3 unconsumedBitsAmount unconsumedOctet septState) =+    if takeLast && unconsumedBitsAmount == 7+      then septExtract =<< septStep septState unconsumedOctet+      else septExtract septState++sizedByteStringFromOctets :: Int -> FoldM IO Word8 ByteString+sizedByteStringFromOctets size = FoldM step init extract where+  init = Product2 0 <$> mallocBytes size+  step (Product2 index ptr) octet = do+    poke (plusPtr ptr index) octet+    return (Product2 (succ index) ptr)+  extract (Product2 _ ptr) = do+    fp <- newForeignPtr finalizerFree ptr+    return (ByteString.PS fp 0 size)++{-# INLINABLE sizedSeptetPrimArrayFromSeptets #-}+sizedSeptetPrimArrayFromSeptets :: Int -> FoldM IO Word8 (PrimArray Word8)+sizedSeptetPrimArrayFromSeptets septetsAmount = FoldM step init extract where+  init = do+    let size = div (septetsAmount * 7 + 7) 8+    mpa <- newPrimArray size+    return (Product4 mpa 0 0 0)+  step (Product4 mpa octetIndex bitIndex unfinishedOctet) inputOctet =+    case bitIndex of+      0 -> return (Product4 mpa octetIndex 7 inputOctet)+      1 -> let+        finishedOctet = unfinishedOctet .|. unsafeShiftL inputOctet 1+        in do+          writePrimArray mpa octetIndex finishedOctet+          return (Product4 mpa (succ octetIndex) 0 0)+      _ -> let+        finishedOctet = unfinishedOctet .|. unsafeShiftL inputOctet bitIndex+        newUnfinishedOctet = unsafeShiftR inputOctet (8 - bitIndex)+        in do+          writePrimArray mpa octetIndex finishedOctet+          return (Product4 mpa (succ octetIndex) (pred bitIndex) newUnfinishedOctet)+  extract (Product4 mpa octetIndex bitIndex unfinishedOctet) = do+    when (bitIndex /= 0) (writePrimArray mpa octetIndex unfinishedOctet)+    unsafeFreezePrimArray mpa
+ library/AsciiString/Prelude.hs view
@@ -0,0 +1,114 @@+module AsciiString.Prelude+(+  module Exports,+  Product2(..),+  Product3(..),+  Product4(..),+  showBits,+)+where+++-- base+-------------------------+import Control.Applicative as Exports+import Control.Arrow as Exports+import Control.Category as Exports+import Control.Concurrent as Exports+import Control.Exception as Exports+import Control.Monad as Exports hiding (mapM_, sequence_, forM_, msum, mapM, sequence, forM)+import Control.Monad.IO.Class as Exports+import Control.Monad.Fix as Exports hiding (fix)+import Control.Monad.ST as Exports+import Data.Bits as Exports+import Data.Bool as Exports+import Data.Char as Exports+import Data.Coerce as Exports+import Data.Complex as Exports+import Data.Data as Exports+import Data.Dynamic as Exports+import Data.Either as Exports+import Data.Fixed as Exports+import Data.Foldable as Exports+import Data.Function as Exports hiding (id, (.))+import Data.Functor as Exports+import Data.Functor.Identity as Exports+import Data.Int as Exports+import Data.IORef as Exports+import Data.Ix as Exports+import Data.List as Exports hiding (sortOn, isSubsequenceOf, uncons, concat, foldr, foldl1, maximum, minimum, product, sum, all, and, any, concatMap, elem, foldl, foldr1, notElem, or, find, maximumBy, minimumBy, mapAccumL, mapAccumR, foldl')+import Data.Maybe as Exports+import Data.Monoid as Exports hiding (Last(..), First(..), (<>))+import Data.Ord as Exports+import Data.Proxy as Exports+import Data.Ratio as Exports+import Data.Semigroup as Exports+import Data.STRef as Exports+import Data.String as Exports+import Data.Traversable as Exports+import Data.Tuple as Exports+import Data.Unique as Exports+import Data.Version as Exports+import Data.Word as Exports+import Debug.Trace as Exports+import Foreign as Exports hiding (void)+import GHC.Conc as Exports hiding (withMVar, threadWaitWriteSTM, threadWaitWrite, threadWaitReadSTM, threadWaitRead)+import GHC.Exts as Exports (lazy, inline, sortWith, groupWith)+import GHC.Generics as Exports (Generic)+import GHC.IO.Exception as Exports+import Numeric as Exports+import Prelude as Exports hiding (concat, foldr, mapM_, sequence_, foldl1, maximum, minimum, product, sum, all, and, any, concatMap, elem, foldl, foldr1, notElem, or, mapM, sequence, id, (.))+import System.Environment as Exports+import System.Exit as Exports+import System.IO as Exports+import System.IO.Error as Exports+import System.IO.Unsafe as Exports+import System.Mem as Exports+import System.Mem.StableName as Exports+import System.Timeout as Exports+import Text.ParserCombinators.ReadP as Exports (ReadP, ReadS, readP_to_S, readS_to_P)+import Text.ParserCombinators.ReadPrec as Exports (ReadPrec, readPrec_to_P, readP_to_Prec, readPrec_to_S, readS_to_Prec)+import Text.Printf as Exports (printf, hPrintf)+import Text.Read as Exports (Read(..), readMaybe, readEither)+import Unsafe.Coerce as Exports++-- bytestring+-------------------------+import Data.ByteString as Exports (ByteString)+import Data.ByteString.Short as Exports (ShortByteString)++-- primitive+-------------------------+import Data.Primitive.PrimArray as Exports hiding (sizeOf, alignment)++-- cereal+-------------------------+import Data.Serialize as Exports++-- foldl+-------------------------+import Control.Foldl as Exports (Fold(..), FoldM(..))++-- deferred-folds+-------------------------+import DeferredFolds.Unfold as Exports (Unfold(..))+import DeferredFolds.UnfoldM as Exports (UnfoldM(..))++-- hashable+-------------------------+import Data.Hashable as Exports+++data Product2 a b = Product2 !a !b++data Product3 a b c = Product3 !a !b !c++data Product4 a b c d = Product4 !a !b !c !d++showBits :: forall a. (Integral a, Show a, FiniteBits a) => a -> String+showBits = padL (finiteBitSize (undefined :: a)) '0' . ($ "") . showIntAtBase 2 intToDigit++padL :: Int -> Char -> String -> String+padL n c s+    | length s < n  = s ++ replicate (n - length s) c+    | otherwise     = s
+ test/Main.hs view
@@ -0,0 +1,49 @@+module Main where++import Prelude+import Test.QuickCheck.Instances+import Test.Tasty+import Test.Tasty.Runners+import Test.Tasty.HUnit+import Test.Tasty.QuickCheck+import qualified Test.QuickCheck as QuickCheck+import qualified Test.QuickCheck.Property as QuickCheck+import qualified Data.ByteString as ByteString+import qualified Data.ByteString.Short as ShortByteString+import qualified Data.Serialize as Serialize+import qualified AsciiString+++main =+  defaultMain $+  testGroup "All" $ let+    listGen = do+      length <- QuickCheck.choose (0, 100)+      replicateM length (QuickCheck.choose (0, 127))+    stringGen = fmap chr <$> listGen+    byteStringGen = ByteString.pack <$> listGen+    shortByteStringGen = ShortByteString.pack <$> listGen+    asciiStringGen = AsciiString.fromSeptetList <$> listGen+    in+      [+        testCase "Reduces the length" $ do+          assertEqual "" 6 (AsciiString.length (AsciiString.fromByteString "123456"))+          assertEqual "" 7 (AsciiString.length (AsciiString.fromByteString "1234567"))+          assertEqual "" 8 (AsciiString.length (AsciiString.fromByteString "12345678"))+          assertEqual "" 14 (AsciiString.length (AsciiString.fromByteString "12345678901234"))+        ,+        testProperty "List roundtrip" $ forAll listGen $ \ list ->+        list === AsciiString.toSeptetList (AsciiString.fromSeptetList list)+        ,+        testProperty "ByteString Roundtrip" $ forAll byteStringGen $ \ byteString ->+        byteString === AsciiString.toByteString (AsciiString.fromByteString byteString)+        ,+        testProperty "ShortByteString Roundtrip" $ forAll shortByteStringGen $ \ sbs ->+        sbs === AsciiString.toShortByteString (AsciiString.fromShortByteString sbs)+        ,+        testProperty "String Roundtrip" $ forAll stringGen $ \ string ->+        show string === show (fromString string :: AsciiString.AsciiString)+        ,+        testProperty "Cereal Roundtrip" $ forAll asciiStringGen $ \ asciiString ->+        Right asciiString === Serialize.decode (Serialize.encode asciiString)+      ]