From f4bb822e5407e9d2003267a66c239e113a199797 Mon Sep 17 00:00:00 2001
From: Joey Hess <joey@kitenet.net>
Date: Thu, 20 Mar 2014 13:20:25 -0400
Subject: [PATCH] added my database experiments

---
 Footype.hs | 20 +++++++++++++++
 foo.hs     | 74 ++++++++++++++++++++++++++++++++++++++++++++++++++++++
 fooes.hs   | 36 ++++++++++++++++++++++++++
 3 files changed, 130 insertions(+)
 create mode 100644 Footype.hs
 create mode 100644 foo.hs
 create mode 100644 fooes.hs

diff --git a/Footype.hs b/Footype.hs
new file mode 100644
index 0000000000..04d6fead63
--- /dev/null
+++ b/Footype.hs
@@ -0,0 +1,20 @@
+{-# LANGUAGE QuasiQuotes, TypeFamilies, GeneralizedNewtypeDeriving, TemplateHaskell,
+             OverloadedStrings, GADTs, FlexibleContexts #-}
+
+module Footype where
+
+import Database.Persist hiding (Key)
+import Database.Persist.TH
+import Database.Persist.Sqlite hiding (Key)
+import Control.Monad.IO.Class (liftIO)
+import Control.Monad
+import Data.Time.Clock
+
+import Types.Key
+import Types.UUID
+import Types.MetaData
+
+-- has to be in a separate file from foo.hs for silly reasons
+derivePersistField "Key"
+derivePersistField "UUID"
+derivePersistField "MetaField"
diff --git a/foo.hs b/foo.hs
new file mode 100644
index 0000000000..047c0b03fc
--- /dev/null
+++ b/foo.hs
@@ -0,0 +1,74 @@
+{-# LANGUAGE QuasiQuotes, TypeFamilies, GeneralizedNewtypeDeriving, TemplateHaskell,
+             OverloadedStrings, GADTs, FlexibleContexts #-}
+import Database.Persist hiding (Key)
+import Database.Persist.TH
+import Database.Persist.Sqlite hiding (Key)
+import Control.Monad.IO.Class (liftIO)
+import Control.Monad
+import Data.Time.Clock
+import Data.Maybe
+
+import Types.Key
+import Types.UUID
+import Types.MetaData
+import Footype
+
+data RemoteFsckTime
+
+share [mkPersist sqlSettings, mkSave "entityDefs", mkMigrate "migrateAll"] [persistLowerCase|
+CachedKey
+  key Key
+  KeyOutdex key
+  deriving Show
+
+AssociatedFiles
+  keyId CachedKeyId Eq
+  associatedFile FilePath
+  KeyIdOutdex keyId associatedFile
+  deriving Show
+
+CachedMetaField
+  field MetaField
+  FieldOutdex field
+  deriving Show
+
+CachedMetaData
+  keyId CachedKeyId Eq
+  fieldId CachedMetaFieldId Eq
+  metaValue String
+  deriving Show
+
+LastFscked
+  keyId CachedKeyId Eq
+  localFscked Int Maybe
+|]
+
+main :: IO ()
+main = query
+
+query :: IO ()
+query = runSqlite "foo.db" $ do
+	forM_ [1..1000] $ \i -> do
+		Just k <- getBy $ KeyOutdex (fromJust $ file2key $ "WORM--" ++ show i)
+		selectList [AssociatedFilesKeyId ==. entityKey k] []
+
+query2 :: IO ()
+query2 = runSqlite "foo.db" $ do
+	forM_ [1..1] $ \i -> do
+		Just f <- getBy $ FieldOutdex (fromJust $ toMetaField "tag")
+		liftIO $ print f
+		fs <- selectList [CachedMetaDataFieldId ==. entityKey f] []
+		liftIO $ print $ length fs
+
+populate :: IO ()
+populate = runSqlite "foo.db"  $ do
+    runMigration migrateAll
+    t <- insert $ CachedMetaField (fromJust $ toMetaField "tag")
+    f <- insert $ CachedMetaField (fromJust $ toMetaField "foo")
+    forM_ [1..30000] $ \i -> do
+    	k <- insert $ CachedKey (fromJust $ file2key $ "WORM--" ++ show i)
+	liftIO $ print k
+	insert $ AssociatedFiles k (show i)
+	insert $ AssociatedFiles k ("and" ++ show (i + 1))
+	insert $ CachedMetaData k f (show i)
+	insert $ CachedMetaData k t "bar"
diff --git a/fooes.hs b/fooes.hs
new file mode 100644
index 0000000000..80f4b7dc51
--- /dev/null
+++ b/fooes.hs
@@ -0,0 +1,36 @@
+{-# LANGUAGE QuasiQuotes, TypeFamilies, GeneralizedNewtypeDeriving, TemplateHaskell,
+             OverloadedStrings, GADTs, FlexibleContexts #-}
+import Database.Persist.TH
+import Database.Persist.Sqlite (runSqlite)
+import Control.Monad.IO.Class (liftIO)
+import Control.Monad
+import Database.Esqueleto hiding (Key)
+
+share [mkPersist sqlSettings, mkSave "entityDefs", mkMigrate "migrateAll"] [persistLowerCase|
+CachedKey
+  key String
+  UniqueKey key
+  deriving Show
+
+AssociatedFiles
+  key CachedKeyId Eq
+  file FilePath
+  UniqueKeyFile key file
+  deriving Show
+|]
+
+main :: IO ()
+main = runSqlite "foo.db" $ do
+	runMigration migrateAll
+
+	forM_ [1..30000] $ \i -> do
+		k <- insert $ CachedKey (show i)
+		liftIO $ print k
+		insert $ AssociatedFiles k (show i)
+
+		[(k2)] <- select $ from $ \k -> do
+			where_ (k ^. CachedKeyKey ==. val (show i))
+			return (k ^. CachedKeyId)
+		liftIO $ print (2, k2)
+		delete $ from $ \f -> do
+			where_ (f ^. AssociatedFilesKey ==. k2)