acid-experiment: init

Author: vaibhavsagar

acid-experiment/ChangeLog.md

@@ -0,0 +1,5 @@
+# Revision history for acid-experiment
+
+## 0.1.0.0  -- YYYY-mm-dd
+
+* First version. Released on an unsuspecting world.

acid-experiment/LICENSE

@@ -0,0 +1,30 @@
+Copyright (c) 2018, Vaibhav Sagar
+
+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 Vaibhav Sagar 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.

acid-experiment/Main.hs

@@ -0,0 +1,89 @@
+{-# LANGUAGE DeriveDataTypeable #-}
+{-# LANGUAGE TemplateHaskell    #-}
+{-# LANGUAGE TypeFamilies       #-}
+
+module Main (main) where
+
+import           Data.Acid
+import           Data.Acid.Remote
+
+import           Control.Applicative
+import           Control.Monad.Reader
+import           Control.Monad.State
+import           Data.ByteString (ByteString(..))
+import           Data.ByteString.UTF8 (toString, fromString)
+import           Data.SafeCopy
+import           Network
+import           System.Environment
+import           System.Exit
+import           System.IO
+
+import           Data.Typeable
+
+import qualified Data.Map             as Map
+
+------------------------------------------------------
+-- The Haskell structure that we want to encapsulate
+
+type Key   = ByteString
+type Value = ByteString
+
+newtype KeyValue_v0 = KeyValue_v0 (Map.Map String String)
+    deriving (Typeable)
+
+newtype KeyValue = KeyValue (Map.Map Key Value)
+    deriving (Typeable)
+
+$(deriveSafeCopy 0 'base ''KeyValue_v0)
+$(deriveSafeCopy 1 'extension ''KeyValue)
+
+------------------------------------------------------
+-- The transaction we will execute over the state.
+
+insertKey_v0 :: String -> String -> Update KeyValue_v0 ()
+insertKey_v0 key value
+    = do KeyValue_v0 m <- get
+         put (KeyValue_v0 (Map.insert key value m))
+
+lookupKey_v0 :: String -> Query KeyValue_v0 (Maybe String)
+lookupKey_v0 key
+    = do KeyValue_v0 m <- ask
+         return (Map.lookup key m)
+
+$(makeAcidic ''KeyValue_v0 ['insertKey_v0, 'lookupKey_v0])
+
+insertKey :: Key -> Value -> Update KeyValue ()
+insertKey key value
+    = do KeyValue m <- get
+         put (KeyValue (Map.insert key value m))
+
+lookupKey :: Key -> Query KeyValue (Maybe Value)
+lookupKey key
+    = do KeyValue m <- ask
+         return (Map.lookup key m)
+
+$(makeAcidic ''KeyValue ['insertKey, 'lookupKey])
+
+instance Migrate KeyValue where
+    type MigrateFrom KeyValue = KeyValue_v0
+    migrate (KeyValue_v0 mp) = KeyValue $ Map.foldrWithKey (\k a -> Map.insert (fromString k) (fromString a)) Map.empty mp
+
+------------------------------------------------------
+-- This is how AcidState is used:
+
+main :: IO ()
+main = do args <- getArgs
+          acid <- openLocalState (KeyValue Map.empty)
+          case args of
+            [key]
+              -> do mbKey <- query acid (LookupKey (fromString key))
+                    case mbKey of
+                      Nothing    -> putStrLn $ key ++ " has no associated value."
+                      Just value -> putStrLn $ key ++ " = " ++ (toString value)
+            [key,val]
+              -> do update acid (InsertKey (fromString key) (fromString val))
+                    putStrLn "Done."
+            _ -> do putStrLn "Usage:"
+                    putStrLn "  key               Lookup the value of 'key'."
+                    putStrLn "  key value         Set the value of 'key' to 'value'."
+          closeAcidState acid

acid-experiment/Setup.hs

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

acid-experiment/acid-experiment.cabal

@@ -0,0 +1,32 @@
+-- Initial acid-experiment.cabal generated by cabal init.  For further
+-- documentation, see http://haskell.org/cabal/users-guide/
+
+name:                acid-experiment
+version:             0.1.0.0
+-- synopsis:
+-- description:
+license:             BSD3
+license-file:        LICENSE
+author:              Vaibhav Sagar
+maintainer:          [email protected]
+-- copyright:
+-- category:
+build-type:          Simple
+extra-source-files:  ChangeLog.md
+cabal-version:       >=1.10
+
+executable acid-experiment
+  main-is:             Main.hs
+  -- other-modules:
+  -- other-extensions:
+  build-depends:       base >=4.9 && <4.10
+                     , acid-state
+                     , bytestring
+                     , containers
+                     , mtl
+                     , network
+                     , safecopy
+                     , unordered-containers
+                     , utf8-string
+  -- hs-source-dirs:
+  default-language:    Haskell2010

acid-experiment/default.nix

@@ -0,0 +1,31 @@
+{ nixpkgs ? import <nixpkgs> {}, compiler ? "default" }:
+
+let
+
+  inherit (nixpkgs) pkgs;
+
+  f = { mkDerivation, acid-state, base, bytestring, containers, mtl
+      , network, safecopy, stdenv, unordered-containers, utf8-string
+      }:
+      mkDerivation {
+        pname = "acid-experiment";
+        version = "0.1.0.0";
+        src = ./.;
+        isLibrary = false;
+        isExecutable = true;
+        executableHaskellDepends = [
+          acid-state base bytestring containers mtl network safecopy
+          unordered-containers utf8-string
+        ];
+        license = stdenv.lib.licenses.bsd3;
+      };
+
+  haskellPackages = if compiler == "default"
+                       then pkgs.haskellPackages
+                       else pkgs.haskell.packages.${compiler};
+
+  drv = haskellPackages.callPackage f {};
+
+in
+
+  if pkgs.lib.inNixShell then drv.env else drv