dynamic-state (empty) → 0.1.0.0

raw patch · 6 files changed

+215/−0 lines, 6 filesdep +basedep +binarydep +bytestringsetup-changed

Dependencies added: base, binary, bytestring, concrete-typerep, hashable, unordered-containers

Files

• LICENSE +30/−0
• Setup.hs +2/−0
• dynamic-state.cabal +34/−0
• src/Data/DynamicState.hs +43/−0
• src/Data/DynamicState/Serializable.hs +84/−0
• src/Data/HashMap/Instances.hs +22/−0

@@ -0,0 +1,30 @@+Copyright 2014-2014 Carter Charbonneau++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions+are met:++1. Redistributions of source code must retain the above copyright+   notice, this list of conditions and the following disclaimer.++2. 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.++3. Neither the name of the author nor the names of his contributors+   may be used to endorse or promote products derived from this software+   without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE AUTHORS ``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 AUTHORS 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,2 @@+import Distribution.Simple+main = defaultMain

@@ -0,0 +1,34 @@+name:                dynamic-state+version:             0.1.0.0+synopsis:            Optionally serializable dynamic state keyed by type+description:         Optionally serializable dynamic state keyed by type+license:             BSD3+license-file:        LICENSE+author:              Carter Charbonneau+maintainer:          zcarterc@gmail.com+category:            Yi, Data+build-type:          Simple+cabal-version:       >=1.10++library+  ghc-options:      -Wall ++  exposed-modules:+    Data.DynamicState+    Data.DynamicState.Serializable+    Data.HashMap.Instances++  build-depends:+      base >=4.5 && <5+    , binary+    , bytestring+    , concrete-typerep >= 0.1.0.2 && < 0.1.1+    , unordered-containers+    , hashable++  hs-source-dirs:      src+  default-language:    Haskell2010++source-repository head+  type:     git+  location: https://github.com/yi-editor/dynamic-state.git

@@ -0,0 +1,43 @@+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE DeriveDataTypeable #-}+{-# OPTIONS_HADDOCK show-extensions #-}++-- |+-- Module      :  Data.DynamicState+-- License     :  BSD3+-- Maintainer  :  zcarterc@gmail.com+-- Stability   :  experimental+-- Portability :  portable+--+-- This module implements a simple HashMap ConcreteTypeRep Dynamic++module Data.DynamicState (+  DynamicState(..),+  getDyn,+  setDyn,+  _dyn+  ) where++import Data.Dynamic+import Data.HashMap.Strict as M+import Data.ConcreteTypeRep+import Data.Monoid+import Control.Applicative++-- | An extensible record, indexed by type+newtype DynamicState = DynamicState { unDynamicState :: M.HashMap ConcreteTypeRep Dynamic }+  deriving (Typeable)++instance Monoid DynamicState where+  mappend (DynamicState a) (DynamicState b) = DynamicState (mappend a b)+  mempty = DynamicState mempty++getDyn :: forall a. Typeable a => DynamicState -> Maybe a+getDyn (DynamicState ds) = M.lookup (cTypeOf (undefined :: a)) ds >>= fromDynamic++setDyn :: forall a. Typeable a => DynamicState -> a -> DynamicState+setDyn (DynamicState ds) x = DynamicState $ M.insert (cTypeOf (undefined :: a)) (toDyn x) ds++-- | Lens with default value+_dyn :: (Typeable a, Functor f) => a -> (a -> f a) -> DynamicState -> f DynamicState+_dyn def afb s = setDyn s <$> afb (maybe def id $ getDyn s)

@@ -0,0 +1,84 @@+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE ExistentialQuantification #-}+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE TupleSections #-}+{-# OPTIONS_HADDOCK show-extensions #-}++-- |+-- Module      :  Data.DynamicState.Serializable+-- License     :  BSD3+-- Maintainer  :  zcarterc@gmail.com+-- Stability   :  experimental+-- Portability :  portable+--+-- This module is HashMap ConcreteTypeRep Dynamic with a twist. The Dynamic+-- used can also be ByteString, to make repeated+-- reserialization cheap.+-- A user-provided State-like is used to store this.++module Data.DynamicState.Serializable (+  Dynamic(..),+  fromDynamic,+  DynamicState(..),+  getDyn,+  putDyn+  ) where++import Data.Binary+import Data.HashMap.Instances()+import Data.HashMap.Strict as M+import Data.ConcreteTypeRep+import Data.Typeable+import Data.ByteString.Lazy(ByteString)+import Control.Applicative+import Data.Monoid+import Control.Monad++-- | A Dynamic value, potentially stored serialized+data Dynamic+  = forall a. (Typeable a, Binary a) => Dynamic !a+  | Serial !ByteString++-- | Try to extract a value from the 'Dynamic', returning True if it was decoded from a 'Serial'+fromDynamic :: forall a. (Typeable a, Binary a) => Dynamic -> Maybe (a,Bool)+fromDynamic (Dynamic b) = (,False) <$> cast b+fromDynamic (Serial bs) = let b = either (const Nothing) (\(_,_,a) -> Just a) $ decodeOrFail bs in (,True) <$> b+++instance Binary Dynamic where+  put = put . toSerialRep where+    toSerialRep (Dynamic a) = encode a+    toSerialRep (Serial bs) = bs+  get = Serial <$> get++-- | An extensible record, indexed by type, using state to cache deserializtion+newtype DynamicState = DynamicState { unDynamicState :: M.HashMap ConcreteTypeRep Dynamic }+  deriving (Typeable)++instance Monoid DynamicState where+  mappend (DynamicState a) (DynamicState b) = DynamicState (mappend a b)+  mempty = DynamicState mempty++-- | Get a value, inside a State-like monad specified by the first two functions+getDyn :: forall m a. (Typeable a, Binary a, Monad m) => m DynamicState -> (DynamicState -> m ()) -> m (Maybe a)+getDyn get' put' = do+    let ty = (cTypeOf (undefined::a))+    dvs <- liftM unDynamicState get'+    case M.lookup ty dvs >>= fromDynamic of+      Just (val,new) -> (when new $ put' $ DynamicState $ M.insert ty (Dynamic val) dvs) >> return val+      Nothing -> return Nothing+-- | Set a value, inside a State-like monad specified by the first two functions+putDyn :: forall m a. (Typeable a, Binary a, Monad m) => m DynamicState -> (DynamicState -> m ()) -> a -> m ()+putDyn get' put' v = do+    dvs <- liftM unDynamicState get'+    put' $ DynamicState (M.insert (cTypeOf (undefined :: a)) (Dynamic v) dvs)++instance Binary DynamicState where+  put (DynamicState ds) = put ds+  get = DynamicState <$> get++-- TODO: since a 'DynamicState' is now serialisable, it could potentially+-- exist for a long time (days/months?). No operations are provided to remove+-- entries. If these start accumulating a lot of junk,+-- it may be necessary to prune them (perhaps keep track of access date and+-- remove the ones more than a month old?).

@@ -0,0 +1,22 @@+{-# OPTIONS_GHC -fno-warn-orphans #-}+{-# OPTIONS_HADDOCK show-extensions #-}++-- |+-- Module      :  Data.HashMap.Instances+-- License     :  BSD3+-- Maintainer  :  zcarterc@gmail.com+-- Stability   :  experimental+-- Portability :  portable+--+-- Orphan Binary instance for HashMap++module Data.HashMap.Instances where++import Control.Applicative+import Data.HashMap.Strict as HashMap+import Data.Hashable+import Data.Binary++instance (Eq k, Hashable k, Binary k, Binary v) => Binary (HashMap.HashMap k v) where+  put x = put (HashMap.toList x)+  get = HashMap.fromList <$> get