packages feed

base91 0.2.0 → 1.0.0

raw patch · 8 files changed

+119/−70 lines, 8 filesdep ~base

Dependency ranges changed: base

Files

Codec/Binary/Base91.hs view
@@ -1,22 +1,25 @@ -- Copyright 2015 Alvaro J. Genial (http://alva.ro) -- see LICENSE.md for more. -- Informed by Mario Rodriguez's C++ implementation. -module Codec.Binary.Base91 (alphabet, decodeBy, encodeBy) where+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeFamilies #-} +module Codec.Binary.Base91 (alphabet, decode, encode) where++import Codec.Binary.Base91.Control (Applicative' (..), Foldable' (..)) import Data.Bits ((.&.), (.|.), shiftL, shiftR) import Data.Char (ord)+import Data.Monoid (mappend, mconcat, mempty) import Data.Word (Word8)  -type LeftFold a b c = (a -> b -> a) -> a -> c -> a---encodeBy :: LeftFold (Int, Int, o) Word8 s -> (o -> [Char] -> o) -> o -> s -> o-encodeBy fold append empty source = g . fold f (0, 0, empty) $ source where+-- | Generically encodes a 'Word8' sequence to a 'Char' sequence in Base91 form.+encode :: forall i o. (Foldable' i, Element i ~ Word8, Applicative' o, Item o ~ Char) => i -> o+encode input = g . fold' f (0, 0, mempty) $ input where ---f :: (Int, Int, o) -> Word8 -> (Int, Int, o)+  f :: (Int, Int, o) -> Word8 -> (Int, Int, o)   f (queue, nbits, output) w =-    let queue' = queue .|. (fromIntegral w `shiftL` nbits)+    let queue' = queue .|. (fromWord8 w `shiftL` nbits)         nbits' = nbits + 8     in if nbits' <= 13 then (queue', nbits', output) else       let val  = queue' .&. 8191@@ -24,36 +27,44 @@           (v, q, n)   = if val > 88             then (val,  queue' `shiftR` 13, nbits' - 13)             else (val', queue' `shiftR` 14, nbits' - 14)-          trail       = [alphabet !! (v `mod` 91),-                         alphabet !! (v `div` 91)]-      in (q, n, append output trail)+          x = pure' $ alphabet !! (v `mod` 91)+          y = pure' $ alphabet !! (v `div` 91)+      in (q, n, mconcat [output, x, y]) ---g :: (Int, Int, o) -> o+  g :: (Int, Int, o) -> o   g (_,     0,     output) = output-  g (queue, nbits, output) = append output (y:z)-    where y = alphabet !! (queue `mod` 91)-          z | nbits > 7 || queue > 90 = [alphabet !! (queue `div` 91)]-            | otherwise               = []+  g (queue, nbits, output) = mconcat [output, x, y]+    where x                           = pure' $ alphabet !! (queue `mod` 91)+          y | nbits > 7 || queue > 90 = pure' $ alphabet !! (queue `div` 91)+            | otherwise               = mempty -decodeBy :: LeftFold (Int, Int, Int, o) Char s -> (o -> [Word8] -> o) -> o -> s -> o-decodeBy fold append empty source = g . fold f (0, 0, -1, empty) $ source where+-- | Generically decodes a 'Word8' sequence from a 'Char' sequence in Base91 form.+decode :: forall i o. (Foldable' i, Element i ~ Char, Applicative' o, Item o ~ Word8) => i -> o+decode input = g . fold' f (0, 0, -1, mempty) $ input where ---f :: (Int, Int, Int, o) -> Char -> (Int, Int, Int, o)+  f :: (Int, Int, Int, o) -> Char -> (Int, Int, Int, o)   f (queue, nbits, val, output) c =-    let d = fromIntegral $ octets !! ord 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)                 q = queue .|. (v `shiftL` nbits)                 n = nbits + (if (v .&. 8191) > 88 then 13 else 14)-                (queue', nbits', trail) = if n - 8 > 7-                  then (q `shiftR` 16, n - 16, [q, q `shiftR` 8])-                  else (q `shiftR` 8,  n - 8,  [q])-             in (queue', nbits', -1, append output $ map fromIntegral trail)+                (queue', nbits', x, y) = if n - 8 > 7+                  then (q `shiftR` 16, n - 16, pure' $ toWord8 q, pure' $ toWord8 $ q `shiftR` 8)+                  else (q `shiftR` 8,  n - 8,  pure' $ toWord8 q, mempty)+             in (queue', nbits', -1, mconcat [output, x, y]) ---g :: (Int, Int, Int, o) -> o+  g :: (Int, Int, Int, o) -> o   g (_,     _,     -1,  output) = output-  g (queue, nbits, val, output) = append output [fromIntegral $ queue .|. (val `shiftL` nbits)]+  g (queue, nbits, val, output) = mappend output x+    where x = pure' $ toWord8 $ queue .|. (val `shiftL` nbits)++toWord8 :: Int -> Word8+toWord8 = fromIntegral++fromWord8 :: Word8 -> Int+fromWord8 = fromIntegral  -- | The list of valid characters within a Base91-encoded string. alphabet :: [Char]
Codec/Binary/Base91/ByteString.hs view
@@ -1,15 +1,29 @@ -- Copyright 2015 Alvaro J. Genial (http://alva.ro) -- see LICENSE.md for more. +{-# LANGUAGE TypeFamilies #-}+ module Codec.Binary.Base91.ByteString (decode, encode) where -import Codec.Binary.Base91 (decodeBy, encodeBy)-import qualified Data.ByteString as BS-import qualified Data.List as L+import Codec.Binary.Base91.Control (Applicative' (..), Foldable' (..))+import Data.ByteString (ByteString)+import Data.Word (Word8)+import qualified Codec.Binary.Base91 as Base91+import qualified Data.ByteString     as BS --- | Encodes octets ('ByteString') to a ['Char'] in Base91; the opposite of 'decode'.-encode :: BS.ByteString -> [Char]-encode = encodeBy BS.foldl' (++) [] --- | Decodes octets ('ByteString') from a ['Char'] in Base91; the opposite of 'encode'.-decode :: [Char] -> BS.ByteString-decode = decodeBy L.foldl' (\bs -> BS.append bs . BS.pack) BS.empty+-- | Encodes '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'.+decode :: [Char] -> ByteString+decode = Base91.decode+++instance Applicative' ByteString where+    type Item ByteString = Word8+    pure' = BS.singleton++instance Foldable' ByteString where+    type Element ByteString = Word8+    fold' = BS.foldl'
Codec/Binary/Base91/Efficient.hs view
@@ -2,14 +2,17 @@  module Codec.Binary.Base91.Efficient (decode, encode) where -import Codec.Binary.Base91 (decodeBy, encodeBy)-import qualified Data.ByteString as BS-import qualified Data.Text as T+import Codec.Binary.Base91.ByteString hiding (decode, encode)+import Codec.Binary.Base91.Text       hiding (decode, encode)+import Data.ByteString (ByteString)+import Data.Text (Text)+import qualified Codec.Binary.Base91 as Base91 --- | Encodes octets ('ByteString') to 'Text' in Base91; the opposite of 'decode'.-encode :: BS.ByteString -> T.Text-encode = encodeBy BS.foldl' (\t -> T.append t . T.pack) T.empty --- | Decodes octets ('ByteString') from 'Text' in Base91; the opposite of 'encode'.-decode :: T.Text -> BS.ByteString-decode = decodeBy T.foldl' (\bs -> BS.append bs . BS.pack) BS.empty+-- | 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
Codec/Binary/Base91/String.hs view
@@ -2,14 +2,14 @@  module Codec.Binary.Base91.String (decode, encode) where -import Codec.Binary.Base91 (decodeBy, encodeBy)-import qualified Data.List as L-import qualified Data.Word as W+import Data.Word (Word8)+import qualified Codec.Binary.Base91 as Base91 --- | Encodes octets (['Word8']) to a 'String' in Base91; the opposite of 'decode'.-encode :: [W.Word8] -> String-encode = encodeBy L.foldl' (++) [] --- | Decodes octets (['Word8']) from a 'String' in Base91; the opposite of 'encode'.-decode :: String -> [W.Word8]-decode = decodeBy L.foldl' (++) []+-- | Encodes ['Word8'] to a 'String' in Base91; the opposite of 'decode'.+encode :: [Word8] -> String+encode = Base91.encode++-- | Decodes ['Word8'] from a 'String' in Base91; the opposite of 'encode'.+decode :: String -> [Word8]+decode = Base91.decode
Codec/Binary/Base91/Text.hs view
@@ -1,16 +1,29 @@ -- Copyright 2015 Alvaro J. Genial (http://alva.ro) -- see LICENSE.md for more. +{-# LANGUAGE TypeFamilies #-}+ module Codec.Binary.Base91.Text (decode, encode) where -import Codec.Binary.Base91 (decodeBy, encodeBy)-import qualified Data.List as L-import qualified Data.Text as T-import qualified Data.Word as W+import Codec.Binary.Base91.Control (Applicative' (..), Foldable' (..))+import Data.Text (Text)+import Data.Word (Word8)+import qualified Codec.Binary.Base91 as Base91+import qualified Data.Text           as T --- | Encodes octets (['Word8']) to 'Text' in Base91; the opposite of 'decode'.-encode :: [W.Word8] -> T.Text-encode = encodeBy L.foldl' (\t -> T.append t . T.pack) T.empty --- | Decodes octets (['Word8']) from 'Text' in Base91; the opposite of 'encode'.-decode :: T.Text -> [W.Word8]-decode = decodeBy T.foldl' (++) []+-- | Encodes ['Word8'] to 'Text' in Base91; the opposite of 'decode'.+encode :: [Word8] -> Text+encode = Base91.encode++-- | Decodes ['Word8'] from 'Text' in Base91; the opposite of 'encode'.+decode :: Text -> [Word8]+decode = Base91.decode+++instance Applicative' Text where+    type Item (Text) = Char+    pure' = T.singleton++instance Foldable' Text where+    type Element (Text) = Char+    fold' = T.foldl'
Main.hs view
@@ -5,10 +5,18 @@ import Codec.Binary.Base91.Efficient as Base91 import Data.ByteString as BS import Data.Text.IO as T-import System.Environment (getArgs)+import System.Environment (getArgs, getProgName)  main :: IO ()-main = getArgs >>= \args -> case args of-  ["encode"] -> BS.getContents >>= T.putStr . Base91.encode-  ["decode"] -> T.getContents >>= BS.putStr . Base91.decode-  _          -> error "invalid arguments"+main = getProgName >>= \name -> getArgs >>= \args -> case name:args of+    "b91enc":[]    -> encode+    "b91dec":[]    -> decode+    _:["-e"]       -> encode+    _:["-d"]       -> decode+    _:["--encode"] -> encode+    _:["--decode"] -> decode+    _              -> error "missing or invalid arguments"++  where+    encode  = BS.getContents >>= T.putStrLn . Base91.encode+    decode  = T.getContents >>= BS.putStr . Base91.decode
Test.hs view
@@ -51,4 +51,4 @@       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 -  helloWorld = ([72,101,108,108,111,44,32,119,111,114,108,100,33], ">OwJh>}A\"=r@@Y?F") -- Hello, World!+  helloWorld = ([72,101,108,108,111,44,32,119,111,114,108,100,33,10], ">OwJh>}A\"=r@@Y?FF") -- "Hello, World!\n"
base91.cabal view
@@ -1,5 +1,5 @@ Name:                  base91-Version:               0.2.0+Version:               1.0.0 Author:                Alvaro J. Genial Maintainer:            ajg Homepage:              https://github.com/ajg/base91