SQLDeps (empty) → 0.1

raw patch · 8 files changed

+334/−0 lines, 8 filesdep +HDBCdep +HDBC-sqlite3dep +basesetup-changed

Dependencies added: HDBC, HDBC-sqlite3, base, hashable, mtl, unordered-containers

Files

• Database/SQLDeps.hs +19/−0
• Database/SQLDeps/Diff.hs +54/−0
• Database/SQLDeps/Engine.hs +100/−0
• Database/SQLDeps/QueryWriter.hs +65/−0
• Database/SQLDeps/Types.hs +47/−0
• Example.hs +31/−0
• SQLDeps.cabal +16/−0
• Setup.hs +2/−0

@@ -0,0 +1,19 @@+{- |+   Module     : Database.SQLDeps+   Copyright  : Copyright (C) 2013 Alexander Thiemann+   License    : BSD3++   Maintainer : Alexander Thiemann <mail@agrafix.net>+   Stability  : provisional+   Portability: portable++Reexport public modules+-}+module Database.SQLDeps+    ( module Database.SQLDeps.Types+    , module Database.SQLDeps.Engine+    )+where++import Database.SQLDeps.Types+import Database.SQLDeps.Engine

@@ -0,0 +1,54 @@+{- |+   Module     : Database.SQLDeps.Diff+   Copyright  : Copyright (C) 2013 Alexander Thiemann+   License    : BSD3++   Maintainer : Alexander Thiemann <mail@agrafix.net>+   Stability  : provisional+   Portability: portable++Helper module that calcuates which SELECT statements are affected by an+UPDATE or INSERT+-}+module Database.SQLDeps.Diff+( affectedSelects )+where++import Database.SQLDeps.Types++selectForTable :: TableName -> [Select] -> [Select]+selectForTable tbl = filter (\(Select _ tbls _) -> tbl `elem` tbls)++selectForTbl :: Upsert -> [Select] -> [Select]+selectForTbl (Insert tbl _) = selectForTable tbl+selectForTbl (Update tbl _ _) = selectForTable tbl++affectsFilter :: (FieldName, FieldVal) -> Filter -> Bool+affectsFilter (fName, fVal) f =+    case f of+      EqualTo fName' eVal -> (fName == fName' && fVal == eVal)+      LargerThan fName' eVal -> (fName == fName' && fVal > eVal)+      SmallerThan fName' eVal -> (fName == fName' && fVal < eVal)++doesApply :: [(FieldName, FieldVal)] -> [Filter] -> Bool+doesApply vals filters =+    or $ concatMap (\v -> map (affectsFilter v) filters) vals++doesAffect :: Upsert -> Select -> Bool+doesAffect (Insert _ vals) (Select _ _ filters) =+    doesApply vals filters++doesAffect (Update _ vals filters) (Select _ _ filters') =+    doesApply vals allF+    where+      allF = filters ++ filters'++affectedSelects :: Upsert -> [Select] -> [Select]+affectedSelects up sels =+    foldl (\s cur ->+               if doesAffect up cur+               then (cur : s)+               else s+          ) [] tbl+    where+      tbl = selectForTbl up sels

@@ -0,0 +1,100 @@+{- |+   Module     : Database.SQLDeps.Engine+   Copyright  : Copyright (C) 2013 Alexander Thiemann+   License    : BSD3++   Maintainer : Alexander Thiemann <mail@agrafix.net>+   Stability  : provisional+   Portability: portable++The core engine for keeping track of computations and their dependencies. Check the Example.hs for+an example use.+-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE ScopedTypeVariables #-}+module Database.SQLDeps.Engine+(+-- * Core functions+  runEngine+, change+, query+-- * Types+, CompId+, DepsM+)+where++import Database.SQLDeps.Types+import Database.SQLDeps.Diff+import Database.SQLDeps.QueryWriter++import Database.HDBC++import Control.Monad.RWS+import qualified Data.HashMap.Strict as HM++data QueryContainer conn+   = QueryContainer+   { _qc_stmt :: Select+   , _qc_compId :: CompId+   , _qc_comp :: DepsM conn ()+   }++-- | Unique identifier given by the user to a computation+type CompId = String+type QueryCollection conn = HM.HashMap Select (CompCollection conn)+type CompCollection conn = HM.HashMap String (QueryContainer conn)++-- | The engines monad, keeping track of queries, dependencies, computations+-- and the connection+type DepsM conn a = RWST conn () (QueryCollection conn) IO a++storeQC :: (IConnection conn) => QueryContainer conn -> DepsM conn ()+storeQC qc@(QueryContainer stmt compId _) =+    do coll <- get+       let new = HM.insertWith update stmt val coll+       put new+    where+      update _ compColl =+          case HM.lookup compId compColl of+            Just _ -> compColl -- computation already stored+            Nothing -> HM.insert compId qc compColl+      val = HM.fromList [(compId, qc)]++-- | Start the frameworks engine with a given HDBC-Connection+runEngine :: (IConnection conn) => conn -> DepsM conn a -> IO a+runEngine conn action =+    do (a, _) <- evalRWST action conn HM.empty+       return a++-- | Run an update/insert query on the database. All depending computations+-- will be run after the update/insert is commited.+change :: forall conn. (IConnection conn) => Upsert -> DepsM conn ()+change upsert =+   do conn <- ask+      let (q, vals) = preparedStmt upsert+      liftIO $ do _ <- run conn q vals+                  commit conn+      selects <- gets HM.keys+      let aff = affectedSelects upsert selects+      mapM_ executeAllComps aff+      return ()+    where+      executeAllComps :: Select -> DepsM conn ()+      executeAllComps s =+          do Just kvComps <- gets (HM.lookup s)+             let comps = HM.toList kvComps+             mapM_ (\(_, QueryContainer _ _ comp) ->+                        comp+                   ) comps+             return ()++-- | Run a query and register it's parent computation. Important: Keep the CompId unique for+-- every unique computation, otherwise you will run into errors+query :: (IConnection conn) => Select -> CompId -> (DepsM conn ()) -> DepsM conn ([[SqlValue]])+query stmt compId comp =+    do conn <- ask+       let (q, vals) = preparedStmt stmt+       res <- liftIO $ quickQuery' conn q vals+       storeQC (QueryContainer stmt compId comp)+       return res

@@ -0,0 +1,65 @@+{- |+   Module     : Database.SQLDeps.QueryWriter+   Copyright  : Copyright (C) 2013 Alexander Thiemann+   License    : BSD3++   Maintainer : Alexander Thiemann <mail@agrafix.net>+   Stability  : provisional+   Portability: portable++Helper module to generate prepared statements from SQLDeps.Types types+-}+module Database.SQLDeps.QueryWriter where++import Database.SQLDeps.Types+import Database.HDBC+import Data.List++fName :: FieldName -> String+fName (tbl, field) = tbl ++ "." ++ field++fFilter :: Filter -> String+fFilter (LargerThan f _) = fName f ++ " > ?"+fFilter (SmallerThan f _) = fName f ++ " < ?"+fFilter (EqualTo f _) = fName f ++ " = ?"++vVal :: FieldVal -> SqlValue+vVal (IntVal i) = toSql i+vVal (StrVal s) = toSql s++vFilter :: Filter -> SqlValue+vFilter (LargerThan _ v) = vVal v+vFilter (SmallerThan _ v) = vVal v+vFilter (EqualTo _ v) = vVal v++class QueryWriter a where+    preparedStmt :: a -> (String, [SqlValue])++instance QueryWriter Upsert where+    preparedStmt (Update table fieldVals filters) =+        (q, vals' ++ vals'')+        where+          vals' = map (vVal . snd) fieldVals+          vals'' = map vFilter filters+          q = "UPDATE " ++ table ++ " SET " ++ ups ++ " "+              ++ (if length filters /= 0 then whereC else "")+          whereC = " WHERE " ++ (intercalate " AND " $ map fFilter filters)+          ups = intercalate ", " (map (\(name, _) -> snd name ++ " = ?") fieldVals)++    preparedStmt (Insert table fieldVals) =+        (q, vals)+        where+          vals = map (vVal . snd) fieldVals+          q = "INSERT INTO " ++ table ++ " ("+              ++ (intercalate ", " $ map (snd . fst) fieldVals) ++ ") VALUES ( "+              ++ (intercalate ", " $ replicate (length fieldVals) "?") ++ ")"++instance QueryWriter Select where+    preparedStmt (Select fields table filters) =+        (q, vals)+        where+          vals = map vFilter filters+          q = "SELECT " ++ (intercalate ", " $ map fName fields) ++ " FROM "+              ++ (intercalate ", " table)+              ++ (if length filters /= 0 then whereC else "")+          whereC = " WHERE " ++ (intercalate " AND " $ map fFilter filters)

@@ -0,0 +1,47 @@+{- |+   Module     : Database.SQLDeps.Types+   Copyright  : Copyright (C) 2013 Alexander Thiemann+   License    : BSD3++   Maintainer : Alexander Thiemann <mail@agrafix.net>+   Stability  : provisional+   Portability: portable++Simple type definitions for SQLDeps+-}+{-# LANGUAGE GADTs #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE UndecidableInstances #-}+{-# LANGUAGE DeriveGeneric #-}+module Database.SQLDeps.Types where++import GHC.Generics+import Data.Hashable++type FieldName = (TableName, String)+type TableName = String++data FieldVal+   = IntVal Int+   | StrVal String+   deriving (Eq, Ord, Generic, Show)++data Select+   = Select [FieldName] [TableName] [Filter]+    deriving (Eq, Ord, Generic, Show)++data Upsert+    = Update TableName [(FieldName, FieldVal)] [Filter]+    | Insert TableName [(FieldName, FieldVal)]+    deriving (Eq, Ord, Generic, Show)++data Filter+    = LargerThan FieldName FieldVal+    | SmallerThan FieldName FieldVal+    | EqualTo FieldName FieldVal+    deriving (Eq, Ord, Generic, Show)++instance Hashable Select+instance Hashable FieldVal+instance Hashable Upsert+instance Hashable Filter

@@ -0,0 +1,31 @@+import Control.Monad.RWS++import Database.HDBC+import Database.HDBC.Sqlite3+import Database.SQLDeps++exampleSelect = Select [("users", "name")] ["users"] [SmallerThan ("users", "age") $ IntVal 5]+exampleInsert a = Insert "users" [ (("users", "name"), StrVal "Alex")+                                 , (("users", "age"), IntVal a)+                                 ]+exampleUpdate = Update "users" [ (("users", "age"), IntVal 2) ] [SmallerThan ("users", "age") $ IntVal 10]++getYoungUsers =+    do young <- query exampleSelect "getYoungUsers" getYoungUsers+       liftIO $ putStrLn "Looking for all users age < 5"+       liftIO $ putStrLn $ show young++insertNewUser age =+    do liftIO $ putStrLn $ "Adding Alex with age " ++ (show age)+       change $ exampleInsert age++main =+    do conn <- connectSqlite3 ":memory:"+       runRaw conn $ "CREATE TABLE users (name TEXT, age INT)"+       runEngine conn $ do getYoungUsers+                           insertNewUser 4+                           insertNewUser 10+                           insertNewUser 1+                           change $ exampleUpdate+       commit conn+       disconnect conn

@@ -0,0 +1,16 @@+Name:                SQLDeps+Version:             0.1+Synopsis:            Calculate db-data dependencies of functions+Description:         Rerun computations that depend on SQL-select statements+License:             BSD3+Author:              Alexander Thiemann+Maintainer:          Alexander Thiemann <mail@agrafix.net>+Copyright:           Copyright (c) 2013 Alexander Thiemann+Build-Type:          Simple+Cabal-Version:       >=1.2+Category:            Database++Library+   Build-Depends:     base >= 3 && < 5, mtl, HDBC, HDBC-sqlite3, hashable, unordered-containers+   Exposed-modules:   Database.SQLDeps, Database.SQLDeps.Types, Database.SQLDeps.Engine+   ghc-options:       -Wall

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