diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,30 @@ +Copyright (c) 2014, Kazuo Koga + +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + * Redistributions in binary form must reproduce the above + copyright notice, this list of conditions and the following + disclaimer in the documentation and/or other materials provided + with the distribution. + + * Neither the name of Kazuo Koga nor the names of other + contributors may be used to endorse or promote products derived + from this software without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT +LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR +A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT +OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, +SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT +LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, +DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY +THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT +(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE +OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/ascii85-conduit.cabal b/ascii85-conduit.cabal new file mode 100644 --- /dev/null +++ b/ascii85-conduit.cabal @@ -0,0 +1,75 @@ +-- Initial ascii85-conduit.cabal generated by cabal init. For further +-- documentation, see http://haskell.org/cabal/users-guide/ + +-- The name of the package. +name: ascii85-conduit + +-- The package version. See the Haskell package versioning policy (PVP) +-- for standards guiding when and how versions should be incremented. +-- http://www.haskell.org/haskellwiki/Package_versioning_policy +-- PVP summary: +-+------- breaking API changes +-- | | +----- non-breaking API additions +-- | | | +--- code changes with no API change +version: 0.1.0.0 + +-- A short (one-line) description of the package. +synopsis: Conduit for encoding ByteString into Ascii85 + +-- A longer description of the package. +description: Conduit for encoding ByteString into Ascii85. + +-- The license under which the package is released. +license: BSD3 + +-- The file containing the license text. +license-file: LICENSE + +-- The package author(s). +author: Kazuo Koga + +-- An email address to which users can send suggestions, bug reports, and +-- patches. +maintainer: Kazuo Koga + +-- A copyright notice. +-- copyright: + +category: Data, Conduit + +build-type: Simple + +-- Constraint on the version of Cabal needed to build this package. +cabal-version: >=1.16 + + +library + default-language: Haskell2010 + hs-source-dirs: src + ghc-options: -Wall -fno-warn-type-defaults + -- Modules exported by the library. + exposed-modules: Data.Conduit.Ascii85 + + -- Modules included in this library but not exported. + -- other-modules: + + -- Other library packages from which modules are imported. + build-depends: base ==4.6.* + , bytestring ==0.10.* + , conduit ==1.0.* + +test-suite spec + default-language: Haskell2010 + type: exitcode-stdio-1.0 + main-is: Spec.hs + hs-source-dirs: test + default-extensions: Rank2Types + build-depends: base ==4.6.* + , bytestring ==0.10.* + , hspec ==1.8.* + , conduit ==1.0.* + , ascii85-conduit ==0.1.* + +source-repository this + type: git + location: https://github.com/kkazuo/ascii85-conduit.git + tag: 0.1.0.0 diff --git a/src/Data/Conduit/Ascii85.hs b/src/Data/Conduit/Ascii85.hs new file mode 100644 --- /dev/null +++ b/src/Data/Conduit/Ascii85.hs @@ -0,0 +1,133 @@ +-- | +-- Conduit for encoding ByteString into Ascii85. +-- +-- * +-- +module Data.Conduit.Ascii85 ( + -- * Conduits + encode, + decode + ) where + +import Control.Monad (replicateM_) +import Data.ByteString (ByteString, pack) +import Data.Conduit -- (Conduit, Consumer, yield) +import qualified Data.Conduit.Binary as CB +import Data.Bits (shift, (.&.)) +import Data.Word (Word8) + +-- | Ascii85 encoder. +encode :: Monad m => Conduit ByteString m ByteString +encode = go + where + next = CB.head + go = do + mx <- next + case mx of + Nothing -> + return () + Just x -> do + my <- next + case my of + Nothing -> do + yield $ pack85 x 0 0 0 2 + return () + Just y -> do + mz <- next + case mz of + Nothing -> do + yield $ pack85 x y 0 0 3 + return () + Just z -> do + mw <- next + case mw of + Nothing -> do + yield $ pack85 x y z 0 4 + return () + Just w -> do + yield $ pack85 x y z w 5 + go + +pack85 :: Word8 -> Word8 -> Word8 -> Word8 -> Int -> ByteString +pack85 x y z w c = + pack $ + if c == 5 && v == 0 + then [122] -- 'z' + else map f $ take c + [ v `div` 85^4 , v `div` 85^3 , v `div` 85^2 , v `div` 85 , v ] + where + v = toInteger x * 2^24 + + toInteger y * 2^16 + + toInteger z * 2^8 + + toInteger w + f n = fromIntegral $ n `mod` 85 + 33 + +unpack85 :: Word8 -> Word8 -> Word8 -> Word8 -> Word8 -> Int -> ByteString +unpack85 x y z w v c = + pack $ map f $ take c + [ n `shift` (-24), n `shift` (-16), n `shift` (-8), n ] + where + n = toInteger x * 85^4 + + toInteger y * 85^3 + + toInteger z * 85^2 + + toInteger w * 85 + + toInteger v + f = fromIntegral . (255 .&.) + +u :: Word8 +u = 117 + +flatten :: Monad m => Conduit ByteString m Word8 +flatten = go + where + next = CB.head + go = do + mx <- next + case mx of + Just x + | x < 33 -> go + | x == 122 -> do + replicateM_ 5 $ yield 0 + go + | u < x -> return () + | otherwise -> do + yield $ x - 33 + go + Nothing -> return () + +-- | Ascii85 decoder. +decode :: Monad m => Conduit ByteString m ByteString +decode = flatten =$= go + where + next = await + go = do + mx <- next + case mx of + Nothing -> + return () + Just x -> do + my <- next + case my of + Nothing -> do + return () + Just y -> do + mz <- next + case mz of + Nothing -> do + yield $ unpack85 x y u u u 1 + return () + Just z -> do + mw <- next + case mw of + Nothing -> do + yield $ unpack85 x y z u u 2 + return () + Just w -> do + mv <- next + case mv of + Nothing -> do + yield $ unpack85 x y z w u 3 + return () + Just v -> do + yield $ unpack85 x y z w v 4 + go diff --git a/test/Spec.hs b/test/Spec.hs new file mode 100644 --- /dev/null +++ b/test/Spec.hs @@ -0,0 +1,1 @@ +{-# OPTIONS_GHC -F -pgmF hspec-discover #-}