glue-common (empty) → 0.4.1

raw patch · 6 files changed

+171/−0 lines, 6 filesdep +QuickCheckdep +asyncdep +basesetup-changed

Dependencies added: QuickCheck, async, base, ekg-core, hashable, hspec, lifted-base, monad-control, quickcheck-instances, text, time, transformers, transformers-base, unordered-containers

Files

LICENSE +30/−0
Setup.hs +2/−0
glue-common.cabal +59/−0
src/Glue/Types.hs +65/−0
test/Main.hs +14/−0
test/Spec.hs +1/−0

+ LICENSE view

@@ -0,0 +1,30 @@+Copyright (c) 2015, Sean Parsons++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 Sean Parsons 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.

+ Setup.hs view

@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain

+ glue-common.cabal view

@@ -0,0 +1,59 @@+name:                   glue-common+version:                0.4.1+synopsis:               Make better services.+description:            Common types and base functions used in the glue family of libraries. +license:                BSD3+license-file:           LICENSE+author:                 Sean Parsons+maintainer:             github@futurenotfound.com+category:               Network+build-type:             Simple+cabal-version:          >=1.10++source-repository head+  type:                 git+  location:             git://github.com/seanparsons/glue.git++library+  exposed-modules:      Glue.Types+  -- other-extensions:+  build-depends:        base >=4.6 && <4.9,+                        transformers,+                        transformers-base,+                        lifted-base,+                        time,+                        monad-control,+                        unordered-containers,+                        hashable,+                        text+  ghc-options:          -rtsopts+                        -Wall+  hs-source-dirs:       src+  default-language:     Haskell2010++test-suite glue-common-tests+  build-depends:        base ==4.*,+                        QuickCheck -any,+                        quickcheck-instances,+                        hspec >=2.1.10,+                        transformers,+                        transformers-base,+                        lifted-base,+                        time,+                        monad-control,+                        unordered-containers,+                        hashable,+                        ekg-core,+                        text,+                        async+  other-modules:        Spec+  ghc-options:          -rtsopts+                        -Wall+                        -O2+                        -threaded+  type:                 exitcode-stdio-1.0+  main-is:              Main.hs+  buildable:            True+  default-language:     Haskell2010+  hs-source-dirs:       test,+                        src

+ src/Glue/Types.hs view

@@ -0,0 +1,65 @@+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE RankNTypes #-}++-- | Module containing the root types and some support functionality.+module Glue.Types(+    BasicService+  , MultiGetService+  , MultiGetRequest+  , MultiGetResponse+  , ResultVar+  , MToIO+  , FailOrSuccess+  , multiGetToBasic+  , basicToMultiGet+  , getResult+  , makeCall+) where++import Control.Applicative+import Data.Hashable+import Control.Concurrent+import qualified Control.Concurrent.MVar.Lifted as MV+import Control.Exception.Base hiding(throw, throwIO, catch)+import Control.Exception.Lifted hiding(throw)+import Control.Monad.Trans.Control+import qualified Data.HashSet as S+import qualified Data.HashMap.Strict as M++-- | Type alias for the most basic form of a service supported.+type BasicService m a b = a -> m b+-- | Type alias for the request portion of a `MultiGetService`.+type MultiGetRequest a = S.HashSet a+-- | Type alias for the response portion of a `MultiGetService`.+type MultiGetResponse a b = M.HashMap a b+-- | Type alias for a service that looks up multiple values and returns multiple results.+type MultiGetService m a b = BasicService m (MultiGetRequest a) (MultiGetResponse a b)+-- | Type alias for the common container of a result used in asynchronous calls.+type ResultVar a = MVar (Either SomeException a)+-- | Run the m into an IO instance for a response.+type MToIO m = forall a. m a -> IO a+-- | Type alias for either a failure or a successful response.+type FailOrSuccess a b = Either SomeException (MultiGetResponse a b)++-- | Convert a 'MultiGetService' into a 'BasicService' that looks up a single key, returning a `Maybe` which determines if the value was present.+multiGetToBasic :: (Hashable a, Eq a, Monad m) => MultiGetService m a b -> BasicService m a (Maybe b)+multiGetToBasic service = (\r -> do+  mapResult <- service (S.singleton r)+  return $ M.lookup r mapResult)++-- | Convert a 'BasicService' into a 'MultiGetService'+basicToMultiGet :: (Hashable a, Eq a, Applicative m) => BasicService m a b -> MultiGetService m a b+basicToMultiGet service =+  let callService resultMap request = liftA2 (flip $ M.insert request) resultMap (service request)+  in  S.foldl' callService (pure M.empty)++-- | Obtain a result from a 'ResultVar' in the 'Monad' of your choice.+getResult :: (MonadBaseControl IO m) => ResultVar a -> m a+getResult var = do+  result <- MV.readMVar var+  either throwIO return result++-- | Makes a multi-get call and handles the error bundling it up inside an 'Either'.+makeCall :: (Eq a, Hashable a, MonadBaseControl IO m) => MultiGetService m a b -> S.HashSet a -> m (FailOrSuccess a b)+makeCall service requests = catch (fmap Right $ service requests) (\(e :: SomeException) -> return $ Left e)

+ test/Main.hs view

@@ -0,0 +1,14 @@+module Main where++import Test.Hspec.Runner+import qualified Spec++customConfig :: Config+customConfig = defaultConfig +  { configColorMode       = ColorAlways+  , configPrintCpuTime    = True+  }+++main :: IO ()+main = hspecWith customConfig Spec.spec

+ test/Spec.hs view

@@ -0,0 +1,1 @@+{-# OPTIONS_GHC -F -pgmF hspec-discover -optF --module-name=Spec #-}