monad-codec (empty) → 0.0.1

raw patch · 4 files changed

+225/−0 lines, 4 filesdep +basedep +containersdep +lenssetup-changed

Dependencies added: base, containers, lens, mtl

Files

• Control/Monad/Codec.hs +161/−0
• LICENSE +26/−0
• Setup.lhs +4/−0
• monad-codec.cabal +34/−0

@@ -0,0 +1,161 @@+{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE RankNTypes #-}++-- | The Codec monad provides functions for encoding and decoding+-- complex data structures with unique integer numbers.  In the+-- simplest case the entire sturecture can be transformed to unique+-- atom (see 'example1' below).  When it is not sufficient to encode+-- the input object with one codec, more complex codec structure can+-- be used (see 'example2' below).  In order to simplify codec+-- manipulations the library relies on a 'lens' package  which provides+-- lenses for typical data types.+--+-- Example:+--+-- > example1 = evalCodec empty $ do+-- >     let xs = "abcabd"+-- >     ys <- mapM (encode id) xs+-- >     zs <- mapM (decode id) ys+-- >     return $ zip zs ys+--+-- >>> example1+-- >>> [('a',0),('b',1),('c',2),('a',0),('b',1),('d',3)]+--+-- > example2 = evalCodec (empty, empty) $ do+-- >     let xs = zip "abcabd" [1, 34342, 5435, 34342, 124, 1]+-- >     ys <- forM xs $ \(x, y) ->+-- >         (,) <$> encode _1 x <*> encode _2 y+-- >     zs <- forM ys $ \(i, j) -> +-- >         (,) <$> decode _1 i <*> decode _2 j+-- >     return (zs, ys)+--+-- >>> fst example2+-- >>> [('a',1),('b',34342),('c',5435),('a',34342),('b',124),('d',1)]+-- >>> snd example2+-- >>> [(0,0),(1,1),(2,2),(0,1),(1,3),(3,0)]++module Control.Monad.Codec+( Codec ()+, AtomCodec (..)+, empty+, AtomLens+, maybeEncode+, encode+, encode'+, maybeDecode+, decode++, runCodec+, evalCodec+, execCodec+) where++import Control.Applicative (Applicative, (<$>))+import Control.Lens (Simple, Lens, view, set)+import qualified Control.Monad.State as S+import qualified Data.Map as M+import qualified Data.IntMap as I++-- | A Codec monad preserves mappings between objects and respective+-- codec components.+newtype Codec c a = Codec (S.State c a)+    deriving (Functor, Applicative, Monad)++-- | Get codec structure from the Codec monad.+getCodec :: Codec c c+getCodec = Codec S.get+{-# INLINE getCodec #-}++-- | Set codec structure within the Codec monad.+setCodec :: c -> Codec c ()+setCodec codec = Codec (S.put codec)+{-# INLINE setCodec #-}++-- | Atomic Codec component, which represents to and fro mapping+-- between 'a' objects and unique intergers.+data AtomCodec a = AtomCodec+    { to    :: !(M.Map a Int)+    , from  :: !(I.IntMap a) }++-- | Empty codec component.+empty :: AtomCodec a+empty = AtomCodec M.empty I.empty++-- | Update the map with the given element and increase the counter.  If the+-- element has not been previously in the map it will be assigned a new unique+-- integer number.+updateMap :: Ord a => M.Map a Int -> a -> M.Map a Int+updateMap mp x =+  case M.lookup x mp of+    Just _k -> mp+    Nothing -> M.insert x n mp+  where+    !n = M.size mp++-- | Just a type synonym for a lens between codec and codec component.+type AtomLens c a = Simple Lens c (AtomCodec a)++-- | Encode the object with codec component identified by the lens.+-- Return Nothing if the object is not present in the atomic+-- codec component.+maybeEncode :: Ord a => AtomLens c a -> a -> Codec c (Maybe Int)+maybeEncode lens x = +    M.lookup x . to . view lens <$> getCodec++-- | Encode the object with codec component identified by the lens.+encode :: Ord a => AtomLens c a -> a -> Codec c Int+encode lens x = do+    codec <- getCodec+    let atomCodec = view lens codec+        m' = updateMap (to atomCodec) x+        y  = m' M.! x+        r' = I.insert y x (from atomCodec)+        codec' = set lens (AtomCodec m' r') codec+    setCodec codec'+    return y++-- | Version of encode which doesn't update the return componenent+-- of the atom codec.  It is useful when we know that particular+-- value (e.g. value of a condition observation) won't be decoded+-- afterwards so there is no need to store it and waste memory.+encode' :: Ord a => AtomLens c a -> a -> Codec c Int+encode' lens x = do+    codec <- getCodec+    let atomCodec = view lens codec+        m' = updateMap (to atomCodec) x+        y  = m' M.! x+        codec' = set lens (atomCodec { to = m' }) codec+    setCodec codec'+    return y++-- | Decode the number with codec component identified by the lens.+-- Return Nothing if the object is not present in the atomic+-- codec component.+maybeDecode :: Ord a => AtomLens c a -> Int -> Codec c (Maybe a)+maybeDecode lens i = +    I.lookup i . from . view lens <$> getCodec++-- | Decode the number with codec component identified by the lens.+-- Report error when the number is not present in the codec component. +decode :: Ord a => AtomLens c a -> Int -> Codec c a+decode lens i = maybeDecode lens i >>= \mx -> case mx of+    Just x  -> return x+    Nothing -> error $ "decode: no " ++ show i ++ " key"++-- | Run the Codec monad with the initial codec value.+-- Return both the result and the final codec state.+-- The obtained codec can be used next to perform subsequent+-- decoding or encoding.+runCodec :: c -> Codec c a -> (a, c)+runCodec codec (Codec state) = S.runState state codec++-- | Evaluate the Codec monad with the initial codec value.+-- Only the monad result will be returned.+evalCodec :: c -> Codec c a -> a+evalCodec codec (Codec state) = S.evalState state codec++-- | Execute the Codec monad with the initial codec value.+-- Only the final codec state will be returned.+execCodec :: c -> Codec c a -> c+execCodec codec (Codec state) = S.execState state codec

@@ -0,0 +1,26 @@+Copyright (c) 2012, IPI PAN+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.++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.

@@ -0,0 +1,4 @@+#! /usr/bin/env runhaskell++> import Distribution.Simple+> main = defaultMain

@@ -0,0 +1,34 @@+name:               monad-codec+version:            0.0.1+synopsis:           Monadic conversion between complex data structures and unique integers+description:+    The library provides functions for encoding and decoding complex data+    structures with unique integer numbers.  The codec structure can be+    explicitly defined which distinguishes this package from a monad-atom+    library.+license:            BSD3+license-file:       LICENSE+cabal-version:      >= 1.6+copyright:          Copyright (c) 2012 IPI PAN+author:             Jakub Waszczuk+maintainer:         waszczuk.kuba@gmail.com+stability:          experimental+category:           Control+homepage:           https://github.com/kawu/monad-codec+build-type:         Simple++library+    build-depends:+        base >= 4 && < 5+      , containers+      , lens+      , mtl >= 2++    exposed-modules:+        Control.Monad.Codec++    ghc-options: -Wall++source-repository head+    type: git+    location: git://github.com/kawu/monad-codec.git