2018-12-26 17:31:55 +00:00
|
|
|
module Database.Store.Backend.SQLiteTest where
|
|
|
|
|
|
|
|
import Database.Store.Backend.SQLite
|
|
|
|
import Protolude
|
|
|
|
import Test.Tasty
|
|
|
|
import Test.Tasty.HUnit
|
|
|
|
|
|
|
|
import Database.SQLite.Simple (NamedParam((:=)))
|
|
|
|
import Database.SQLite.Simple.FromRow (FromRow (..))
|
|
|
|
import Database.SQLite.Simple.ToRow (ToRow (..))
|
|
|
|
import Database.Store (DefaultMetas (..), Entity (..),
|
|
|
|
Id (..), Store (..))
|
|
|
|
import qualified Database.Store.CRUD as CRUD
|
|
|
|
import qualified Database.Store.Search as Search
|
|
|
|
import Generics.SOP
|
|
|
|
import System.Directory
|
|
|
|
|
|
|
|
|
|
|
|
data NewFoo = NewFoo { name :: Text, age :: Int } deriving (Protolude.Generic,Eq,Ord)
|
|
|
|
instance Generics.SOP.Generic NewFoo
|
|
|
|
instance Generics.SOP.HasDatatypeInfo NewFoo
|
|
|
|
instance SQLiteSchemas NewFoo
|
|
|
|
instance FromRow NewFoo where fromRow = genericFromRow
|
|
|
|
instance ToRow NewFoo where toRow = genericToRow
|
|
|
|
|
|
|
|
type Foo = Entity DefaultMetas NewFoo
|
|
|
|
|
|
|
|
testSQLiteGenerics :: [TestTree]
|
|
|
|
testSQLiteGenerics = [ testCase "sqlSchemaTxt" sqlSchemaTxtTest
|
|
|
|
, testCase "updateFieldTest" updateFieldsTest
|
|
|
|
]
|
|
|
|
|
|
|
|
sqlSchemaTxtTest :: Assertion
|
|
|
|
sqlSchemaTxtTest = sqlSchemaTxt (Proxy :: Proxy NewFoo) @?= "name TEXT,age INT"
|
|
|
|
|
|
|
|
sqlSchemaTxtEntityTest :: Assertion
|
|
|
|
sqlSchemaTxtEntityTest = sqlSchemaTxt (Proxy :: Proxy Foo) @?= "name TEXT,age INT"
|
|
|
|
|
|
|
|
updateFieldsTest :: Assertion
|
|
|
|
updateFieldsTest =
|
|
|
|
let pfoo = Proxy :: Proxy NewFoo
|
|
|
|
in updateFields pfoo @?= "name := :name,age := :age"
|
|
|
|
|
|
|
|
updateFieldsEntityTest :: Assertion
|
|
|
|
updateFieldsEntityTest =
|
|
|
|
let pfoo = Proxy :: Proxy Foo
|
|
|
|
in updateFields pfoo @?= "name := :name,age := :age"
|
|
|
|
|
|
|
|
testSQLiteCRUD :: [TestTree]
|
|
|
|
testSQLiteCRUD = [ testCaseSteps "create" sqlCRUD ]
|
|
|
|
|
|
|
|
saferm :: FilePath -> IO ()
|
|
|
|
saferm fic = do
|
|
|
|
fileExists <- doesFileExist fic
|
|
|
|
when fileExists $ removeFile fic
|
|
|
|
|
|
|
|
withTestDB :: (Text -> IO a) -> IO a
|
|
|
|
withTestDB actions = do
|
|
|
|
let tmpdbfile = ".test.db"
|
|
|
|
saferm tmpdbfile
|
|
|
|
res <- actions (toS tmpdbfile)
|
|
|
|
saferm tmpdbfile
|
|
|
|
return res
|
|
|
|
|
|
|
|
sqlCRUD :: IsString t => (t -> IO a) -> IO ()
|
|
|
|
sqlCRUD step = withTestDB $ \tmpfile -> do
|
|
|
|
void $ step "Initalizing"
|
|
|
|
store <- initDBFoos (SQLiteConf tmpfile "foo")
|
|
|
|
void $ step "Get something"
|
|
|
|
res1 <- readFoo store (Id "0000-0000-0000-000000000000-000000000000")
|
|
|
|
case res1 of
|
|
|
|
Just _ -> assertFailure "The DB Should be empty!"
|
|
|
|
Nothing -> return ()
|
|
|
|
void $ step "Create something"
|
|
|
|
let newFoo1 = NewFoo { name = "Yann", age = 42 }
|
|
|
|
foo1 <- createFoo store newFoo1
|
|
|
|
void $ step "Get created entity"
|
|
|
|
foo2 <- readFoo store (id foo1)
|
|
|
|
when (Just foo1 /= foo2) $ assertFailure "Foo1 and Foo2 should be equal"
|
|
|
|
void $ step "Search created entity by name"
|
2019-01-25 21:31:23 +00:00
|
|
|
SR (Paginated foos _ _) <- searchFoos store (Filter {params = ["name" := ("Yann" :: Text)]})
|
2018-12-26 17:31:55 +00:00
|
|
|
when (length foos /= 1) $ assertFailure "Bad numbers of found elements"
|
|
|
|
when (head foos /= Just foo1) $ assertFailure "Search returned the bad result"
|
|
|
|
void $ step "cleaning up temporary files"
|
|
|
|
|
|
|
|
type FooSQLiteStore = SQLiteStore IO DefaultMetas NewFoo
|
|
|
|
type DBStore = StartedStore FooSQLiteStore
|
|
|
|
type FooConf = DBConf FooSQLiteStore
|
|
|
|
type FooSearchQuery = Search.SearchQuery FooSQLiteStore
|
|
|
|
type FooSearchResult = Search.SearchResult FooSQLiteStore
|
|
|
|
|
|
|
|
initDBFoos :: FooConf -> IO DBStore
|
|
|
|
initDBFoos = init
|
|
|
|
|
|
|
|
stopDBFoos :: DBStore -> IO ()
|
|
|
|
stopDBFoos = stop
|
|
|
|
|
|
|
|
createFoo :: DBStore -> NewFoo -> IO Foo
|
|
|
|
createFoo = CRUD.create
|
|
|
|
|
|
|
|
readFoo :: DBStore -> Id -> IO (Maybe Foo)
|
|
|
|
readFoo = CRUD.read
|
|
|
|
|
|
|
|
updateFoo :: DBStore -> Id -> NewFoo -> IO (Maybe Foo)
|
|
|
|
updateFoo = CRUD.update
|
|
|
|
|
|
|
|
deleteFoo :: DBStore -> Id -> IO Bool
|
|
|
|
deleteFoo = CRUD.delete
|
|
|
|
|
|
|
|
searchFoos :: DBStore -> FooSearchQuery -> IO FooSearchResult
|
|
|
|
searchFoos = Search.search
|