diff --git a/Codec/Binary/Base91.hs b/Codec/Binary/Base91.hs --- a/Codec/Binary/Base91.hs +++ b/Codec/Binary/Base91.hs @@ -22,11 +22,11 @@ let queue' = queue .|. (fromWord8 w `shiftL` nbits) nbits' = nbits + 8 in if nbits' <= 13 then (queue', nbits', output) else - let val = queue' .&. 8191 - val' = queue' .&. 16383 - (v, q, n) = if val > 88 - then (val, queue' `shiftR` 13, nbits' - 13) - else (val', queue' `shiftR` 14, nbits' - 14) + let value = queue' .&. 8191 + value' = queue' .&. 16383 + (v, q, n) = if value > 88 + then (value, queue' `shiftR` 13, nbits' - 13) + else (value', queue' `shiftR` 14, nbits' - 14) x = pure' $ alphabet !! (v `mod` 91) y = pure' $ alphabet !! (v `div` 91) in (q, n, mconcat [output, x, y]) @@ -43,11 +43,11 @@ decode input = g . fold' f (0, 0, -1, mempty) $ input where f :: (Int, Int, Int, o) -> Char -> (Int, Int, Int, o) - f (queue, nbits, val, output) c = - let d = fromWord8 $ octets !! ord c - in if d == 91 then (queue, nbits, val, output) else - if val == -1 then (queue, nbits, d, output) else - let v = val + (d * 91) + f (queue, nbits, value, output) c = + let octet = fromWord8 $ octets !! ord c + in if octet == 91 then (queue, nbits, value, output) else + if value == -1 then (queue, nbits, octet, output) else + let v = value + (octet * 91) q = queue .|. (v `shiftL` nbits) n = nbits + (if (v .&. 8191) > 88 then 13 else 14) (queue', nbits', x, y) = if n - 8 > 7 @@ -57,8 +57,8 @@ g :: (Int, Int, Int, o) -> o g (_, _, -1, output) = output - g (queue, nbits, val, output) = mappend output x - where x = pure' $ toWord8 $ queue .|. (val `shiftL` nbits) + g (queue, nbits, value, output) = mappend output x + where x = pure' $ toWord8 $ queue .|. (value `shiftL` nbits) toWord8 :: Int -> Word8 toWord8 = fromIntegral diff --git a/Codec/Binary/Base91/ByteString.hs b/Codec/Binary/Base91/ByteString.hs --- a/Codec/Binary/Base91/ByteString.hs +++ b/Codec/Binary/Base91/ByteString.hs @@ -11,11 +11,11 @@ import qualified Data.ByteString as BS --- | Encodes 'ByteString' to ['Char'] in Base91; the opposite of 'decode'. +-- | Encodes a 'ByteString' to ['Char'] in Base91; the opposite of 'decode'. encode ::ByteString -> [Char] encode = Base91.encode --- | Decodes 'ByteString' from ['Char'] in Base91; the opposite of 'encode'. +-- | Decodes a 'ByteString' from ['Char'] in Base91; the opposite of 'encode'. decode :: [Char] -> ByteString decode = Base91.decode diff --git a/Codec/Binary/Base91/ByteString/Lazy.hs b/Codec/Binary/Base91/ByteString/Lazy.hs new file mode 100644 --- /dev/null +++ b/Codec/Binary/Base91/ByteString/Lazy.hs @@ -0,0 +1,29 @@ +-- Copyright 2015 Alvaro J. Genial (http://alva.ro) -- see LICENSE.md for more. + +{-# LANGUAGE TypeFamilies #-} + +module Codec.Binary.Base91.ByteString.Lazy (decode, encode) where + +import Codec.Binary.Base91.Control (Applicative' (..), Foldable' (..)) +import Data.ByteString.Lazy (ByteString) +import Data.Word (Word8) +import qualified Codec.Binary.Base91 as Base91 +import qualified Data.ByteString.Lazy as BSL + + +-- | Encodes a (lazy) 'ByteString' to ['Char'] in Base91; the opposite of 'decode'. +encode ::ByteString -> [Char] +encode = Base91.encode + +-- | Decodes a (lazy) 'ByteString' from ['Char'] in Base91; the opposite of 'encode'. +decode :: [Char] -> ByteString +decode = Base91.decode + + +instance Applicative' ByteString where + type Item ByteString = Word8 + pure' = BSL.singleton + +instance Foldable' ByteString where + type Element ByteString = Word8 + fold' = BSL.foldl' diff --git a/Codec/Binary/Base91/Efficient/Lazy.hs b/Codec/Binary/Base91/Efficient/Lazy.hs new file mode 100644 --- /dev/null +++ b/Codec/Binary/Base91/Efficient/Lazy.hs @@ -0,0 +1,18 @@ +-- Copyright 2015 Alvaro J. Genial (http://alva.ro) -- see LICENSE.md for more. + +module Codec.Binary.Base91.Efficient.Lazy (decode, encode) where + +import Codec.Binary.Base91.ByteString.Lazy hiding (decode, encode) +import Codec.Binary.Base91.Text.Lazy hiding (decode, encode) +import Data.ByteString.Lazy (ByteString) +import Data.Text.Lazy (Text) +import qualified Codec.Binary.Base91 as Base91 + + +-- | Encodes 'ByteString' to 'Text' in Base91; the opposite of 'decode'. +encode :: ByteString -> Text +encode = Base91.encode + +-- | Decodes 'ByteString' from 'Text' in Base91; the opposite of 'encode'. +decode :: Text -> ByteString +decode = Base91.decode diff --git a/Codec/Binary/Base91/Text/Lazy.hs b/Codec/Binary/Base91/Text/Lazy.hs new file mode 100644 --- /dev/null +++ b/Codec/Binary/Base91/Text/Lazy.hs @@ -0,0 +1,29 @@ +-- Copyright 2015 Alvaro J. Genial (http://alva.ro) -- see LICENSE.md for more. + +{-# LANGUAGE TypeFamilies #-} + +module Codec.Binary.Base91.Text.Lazy (decode, encode) where + +import Codec.Binary.Base91.Control (Applicative' (..), Foldable' (..)) +import Data.Text.Lazy (Text) +import Data.Word (Word8) +import qualified Codec.Binary.Base91 as Base91 +import qualified Data.Text.Lazy as TL + + +-- | Encodes ['Word8'] to (lazy) 'Text' in Base91; the opposite of 'decode'. +encode :: [Word8] -> Text +encode = Base91.encode + +-- | Decodes ['Word8'] from (lazy) 'Text' in Base91; the opposite of 'encode'. +decode :: Text -> [Word8] +decode = Base91.decode + + +instance Applicative' Text where + type Item (Text) = Char + pure' = TL.singleton + +instance Foldable' Text where + type Element (Text) = Char + fold' = TL.foldl' diff --git a/Test.hs b/Test.hs --- a/Test.hs +++ b/Test.hs @@ -1,54 +1,87 @@ -- Copyright 2015 Alvaro J. Genial (http://alva.ro) -- see LICENSE.md for more. -import Codec.Binary.Base91.ByteString as A (decode, encode) -import Codec.Binary.Base91.Efficient as B (decode, encode) -import Codec.Binary.Base91.String as C (decode, encode) -import Codec.Binary.Base91.Text as D (decode, encode) -import qualified Data.ByteString as BS -import qualified Data.Text as T +import qualified Codec.Binary.Base91.ByteString as BS' (decode, encode) +import qualified Codec.Binary.Base91.ByteString.Lazy as BSL' (decode, encode) +import qualified Codec.Binary.Base91.Efficient as E' (decode, encode) +import qualified Codec.Binary.Base91.Efficient.Lazy as EL' (decode, encode) +import qualified Codec.Binary.Base91.String as S' (decode, encode) +import qualified Codec.Binary.Base91.Text as T' (decode, encode) +import qualified Codec.Binary.Base91.Text.Lazy as TL' (decode, encode) +import qualified Data.ByteString as BS +import qualified Data.ByteString.Lazy as BSL +import qualified Data.Text as T +import qualified Data.Text.Lazy as TL import Test.QuickCheck main :: IO () main = do + testString testByteString + testByteStringLazy + testText + testTextLazy testEfficient - testString - testText where + testEfficientLazy + where -- Note that the reverse identities, e.g. encode (decode cs) == cs, aren't true because not every -- arbitrary character sequence is valid Base91, even if each character is constrained to the -- Base91 alphabet. - testByteString = do + testString = do quickCheck $ prop_identity quickCheck $ example ([], []) quickCheck $ example helloWorld where - prop_identity ws = A.decode (A.encode bs) == bs where bs = BS.pack ws - example (ws, cs) = A.encode bs == cs && A.decode cs == bs where bs = BS.pack ws + prop_identity ws = S'.decode (S'.encode ws) == ws + example (ws, cs) = S'.encode ws == cs && S'.decode cs == ws - testEfficient = do + testByteString = do quickCheck $ prop_identity quickCheck $ example ([], []) quickCheck $ example helloWorld where - prop_identity ws = B.decode (B.encode bs) == bs where bs = BS.pack ws - example (ws, cs) = B.encode bs == t && B.decode t == bs where (bs, t) = (BS.pack ws, T.pack cs) + prop_identity ws = BS'.decode (BS'.encode bs) == bs where bs = BS.pack ws + example (ws, cs) = BS'.encode bs == cs && BS'.decode cs == bs where bs = BS.pack ws - testString = do + testByteStringLazy = do quickCheck $ prop_identity quickCheck $ example ([], []) quickCheck $ example helloWorld where - prop_identity ws = C.decode (C.encode ws) == ws - example (ws, cs) = C.encode ws == cs && C.decode cs == ws + prop_identity ws = BSL'.decode (BSL'.encode bs) == bs where bs = BSL.pack ws + example (ws, cs) = BSL'.encode bs == cs && BSL'.decode cs == bs where bs = BSL.pack ws testText = do quickCheck $ prop_identity quickCheck $ example ([], []) quickCheck $ example helloWorld where - prop_identity ws = D.decode (D.encode ws) == ws - example (ws, cs) = D.encode ws == t && D.decode t == ws where t = T.pack cs + prop_identity ws = T'.decode (T'.encode ws) == ws + example (ws, cs) = T'.encode ws == t && T'.decode t == ws where t = T.pack cs + + testTextLazy = do + quickCheck $ prop_identity + quickCheck $ example ([], []) + quickCheck $ example helloWorld + where + prop_identity ws = TL'.decode (TL'.encode ws) == ws + example (ws, cs) = TL'.encode ws == t && TL'.decode t == ws where t = TL.pack cs + + testEfficient = do + quickCheck $ prop_identity + quickCheck $ example ([], []) + quickCheck $ example helloWorld + where + prop_identity ws = E'.decode (E'.encode bs) == bs where bs = BS.pack ws + example (ws, cs) = E'.encode bs == t && E'.decode t == bs where (bs, t) = (BS.pack ws, T.pack cs) + + testEfficientLazy = do + quickCheck $ prop_identity + quickCheck $ example ([], []) + quickCheck $ example helloWorld + where + prop_identity ws = EL'.decode (EL'.encode bs) == bs where bs = BSL.pack ws + example (ws, cs) = EL'.encode bs == t && EL'.decode t == bs where (bs, t) = (BSL.pack ws, TL.pack cs) helloWorld = ([72,101,108,108,111,44,32,119,111,114,108,100,33,10], ">OwJh>}A\"=r@@Y?FF") -- "Hello, World!\n" diff --git a/base91.cabal b/base91.cabal --- a/base91.cabal +++ b/base91.cabal @@ -1,13 +1,13 @@ Name: base91 -Version: 1.0.1 +Version: 1.1.0 Author: Alvaro J. Genial Maintainer: ajg Homepage: https://github.com/ajg/base91 Synopsis: A Base91 Encoder & Decoder Description: An implementation of Base91 encoding & decoding of arbitrary bytes (octets) - to/from characters (all in the ASCII printable range; it includes support for - plain Strings, as well as optional support for ByteString and/or Text; see - the Flags section for details. + to/from characters (all in the ASCII printable range); it includes support + for plain Strings, as well as optional support for ByteString and/or Text and + their lazy variants; see the Flags section for details. License: MIT License-File: LICENSE.md Category: Codec @@ -15,11 +15,11 @@ Cabal-Version: >= 1.8 Flag ByteString - Description: Enable Data.ByteString support. + Description: Enable support for Data.ByteString and Data.ByteString.Lazy. Default: True Flag Text - Description: Enable Data.Text support. + Description: Enable support for Data.Text and Data.Text.Lazy. Default: True Library @@ -28,14 +28,14 @@ if flag(ByteString) Build-Depends: bytestring - Exposed-Modules: Codec.Binary.Base91.ByteString + Exposed-Modules: Codec.Binary.Base91.ByteString, Codec.Binary.Base91.ByteString.Lazy if flag(Text) Build-Depends: text - Exposed-Modules: Codec.Binary.Base91.Text + Exposed-Modules: Codec.Binary.Base91.Text, Codec.Binary.Base91.Text.Lazy if flag(ByteString) && flag(Text) - Exposed-Modules: Codec.Binary.Base91.Efficient + Exposed-Modules: Codec.Binary.Base91.Efficient, Codec.Binary.Base91.Efficient.Lazy Executable base91 Main-is: Main.hs