LambdaDB 0.0.0.5 → 0.0.0.6
raw patch · 7 files changed
+161/−115 lines, 7 filesdep +QuickCheckPVP: major bump suggested
API removals or changes: PVP suggests a major version bump
Dependencies added: QuickCheck
API changes (from Hackage documentation)
- Database.LambdaDB: ComError :: Command
- Database.LambdaDB.Command: ComError :: Command
+ Database.LambdaDB: ComDelete :: Key -> Command
+ Database.LambdaDB: None :: None
+ Database.LambdaDB: data None
+ Database.LambdaDB.Command: ComDelete :: Key -> Command
Files
- LambdaDB.cabal +48/−47
- src/Database/LambdaDB.hs +1/−0
- src/Database/LambdaDB/Command.hs +10/−8
- src/Database/LambdaDB/DBType.hs +1/−1
- src/Database/LambdaDB/DataType.hs +1/−0
- src/Lib.hs +60/−57
- test/Spec.hs +40/−2
LambdaDB.cabal view
@@ -1,47 +1,48 @@-name: LambdaDB-version: 0.0.0.5-synopsis: On-memory Database using Lambda Function environment.-description: Please see README.md-homepage: https://github.com/ailrun/LambdaDB/blob/master/README.md-license: BSD3-license-file: LICENSE-author: Junyoung Clare Jang-maintainer: jjc9310@gmail.com-copyright: 2016 Junyoung Clare Jang-category: Database-build-type: Simple--- extra-source-files:-cabal-version: >=1.10--library- hs-source-dirs: src- exposed-modules: Lib- , Database.LambdaDB- , Database.LambdaDB.Command- , Database.LambdaDB.DBType- , Database.LambdaDB.DataType- build-depends: base >= 4.7 && < 5- , containers- , transformers- default-language: Haskell2010--executable LambdaDB-exe- hs-source-dirs: app- main-is: Main.hs- ghc-options: -threaded -rtsopts -with-rtsopts=-N- build-depends: base- , LambdaDB- default-language: Haskell2010--test-suite LambdaDB-test- type: exitcode-stdio-1.0- hs-source-dirs: test- main-is: Spec.hs- build-depends: base- , LambdaDB- ghc-options: -threaded -rtsopts -with-rtsopts=-N- default-language: Haskell2010--source-repository head- type: git- location: https://github.com/ailrun/LambdaDB+name: LambdaDB +version: 0.0.0.6 +synopsis: On-memory Database using Lambda Function environment. +description: Please see README.md +homepage: https://github.com/ailrun/LambdaDB/blob/master/README.md +license: BSD3 +license-file: LICENSE +author: Junyoung Clare Jang +maintainer: jjc9310@gmail.com +copyright: 2016 Junyoung Clare Jang +category: Database +build-type: Simple +-- extra-source-files: +cabal-version: >=1.10 + +library + hs-source-dirs: src + exposed-modules: Lib + , Database.LambdaDB + , Database.LambdaDB.Command + , Database.LambdaDB.DBType + , Database.LambdaDB.DataType + build-depends: base >= 4.7 && < 5 + , containers + , transformers + default-language: Haskell2010 + +executable LambdaDB-exe + hs-source-dirs: app + main-is: Main.hs + ghc-options: -threaded -rtsopts -with-rtsopts=-N + build-depends: base + , LambdaDB + default-language: Haskell2010 + +test-suite LambdaDB-test + type: exitcode-stdio-1.0 + hs-source-dirs: test + main-is: Spec.hs + build-depends: base + , QuickCheck + , LambdaDB + ghc-options: -threaded -rtsopts -with-rtsopts=-N + default-language: Haskell2010 + +source-repository head + type: git + location: https://github.com/ailrun/LambdaDB
src/Database/LambdaDB.hs view
@@ -2,6 +2,7 @@ ( Command(..), DB(..), DBData(..), + None(..), Key, initDB, insertData,
src/Database/LambdaDB/Command.hs view
@@ -6,10 +6,10 @@ import Database.LambdaDB.DataType -data Command = ComError - | ComQuit +data Command = ComQuit | ComStatus | ComInsert Key DBData + | ComDelete Key | ComFind Key deriving (Show) @@ -19,20 +19,22 @@ (\x -> [(ComQuit, t) | (s, t) <- lex x, "quit" <- [map toLower s]]) r - ++ - readParen (d > app_prec) + ++ readParen (d > app_prec) (\x -> [(ComStatus, t) | (s, t) <- lex x, "status" <- [map toLower s]]) r - ++ - readParen (d > app_prec) + ++ readParen (d > app_prec) (\x -> [(ComInsert k v, w) | (s, t) <- lex x, "insert" <- [map toLower s], (k, u) <- lex t, (v, w) <- readsPrec 0 u]) r - ++ - readParen (d > app_prec) + ++ readParen (d > app_prec) + (\x -> [(ComDelete k, u) | + (s, t) <- lex x, + "delete" <- [map toLower s], + (k, u) <- lex t]) r + ++ readParen (d > app_prec) (\x -> [(ComFind k, u) | (s, t) <- lex x, "find" <- [map toLower s],
src/Database/LambdaDB/DBType.hs view
@@ -20,7 +20,7 @@ $ \x -> if (x == key) then value else - unLambda db key + unLambda db x findData :: Key -> DB -> DBData findData key db = unLambda db key
src/Database/LambdaDB/DataType.hs view
@@ -50,6 +50,7 @@ DBNone None -> showString "None" DBBool b -> showsPrec d b DBChar c -> showsPrec d c + DBString s -> showString s DBInt i -> showsPrec d i DBInteger ii -> showParen (d > app_prec) $ showsPrec (app_prec+1) ii . showString "i"
src/Lib.hs view
@@ -1,57 +1,60 @@-module Lib- ( dbInit,- dbProc,- dbTerm- ) where---- Standard libraries-import Data.Data--import Control.Monad-import Control.Monad.Trans.Class-import Control.Monad.Trans.Maybe---- Custom libraries-import Database.LambdaDB--dbInit :: IO DB-dbInit = do- putStrLn "Initiate DB ..."- return initDB--dbProc :: DB -> IO ()-dbProc d = void . runMaybeT $ do- lift . putStrLn $ "DB is now running"- void . g $ d- return ()- where g db = do- com <- lift getLine- newdb <- case com of- "" -> lift . return $ db- _ ->- case (read com) of- ComQuit -> mzero- ComStatus -> lift . dbStatus $ db- ComInsert k v -> lift . dbInsert k v $ db- ComFind k -> lift . dbFind k $ db- _ -> do- lift . putStrLn $ "Command Error"- return db- g newdb--dbStatus :: DB -> IO DB-dbStatus db = do- putStrLn "On running"- return db--dbInsert :: Key -> DBData -> DB -> IO DB-dbInsert k v db = do- return . insertData k v $ db--dbFind :: Key -> DB -> IO DB-dbFind k db = do- putStrLn . show . findData k $ db- return db--dbTerm :: IO ()-dbTerm = putStrLn "Terminate DB"+module Lib + ( dbInit, + dbProc, + dbTerm + ) where + +-- Standard libraries +import Control.Monad +import Control.Monad.Trans.Class +import Control.Monad.Trans.Maybe + +-- Custom libraries +import Database.LambdaDB + +dbInit :: IO DB +dbInit = do + putStrLn "Initiate DB ..." + return initDB + +dbProc :: DB -> IO () +dbProc d = void . runMaybeT $ do + lift . putStrLn $ "DB is now running" + void . g $ d + return () + where g db = do + com <- lift getLine + newdb <- case com of + "" -> lift . return $ db + _ -> + case (readsPrec 0 com) of + (ComQuit, _):_ -> mzero + (ComStatus, _):_ -> lift . dbStatus $ db + (ComInsert k v, _):_ -> lift . dbInsert k v $ db + (ComDelete k, _):_ -> do + lift. print $ k + lift. dbInsert k (DBNone None) $ db + (ComFind k, _):_ -> lift . dbFind k $ db + _ -> do + lift . putStrLn $ "Command Error" + return db + g newdb + +dbStatus :: DB -> IO DB +dbStatus db = do + putStrLn "On running" + return db + +dbInsert :: Key -> DBData -> DB -> IO DB +dbInsert k v db = do + let newdb = insertData k v db + putStrLn "OK" + return newdb + +dbFind :: Key -> DB -> IO DB +dbFind k db = do + putStrLn . show . findData k $ db + return db + +dbTerm :: IO () +dbTerm = putStrLn "Terminate DB"
test/Spec.hs view
@@ -1,2 +1,40 @@-main :: IO ()-main = putStrLn "Test suite not yet implemented"+import Control.Monad + +import Test.QuickCheck +import Database.LambdaDB + +instance Arbitrary DBData where + arbitrary = oneof [ liftM DBNone (return None), + liftM DBBool arbitrary, + liftM DBChar arbitrary, + liftM DBString arbitrary, + liftM DBInt arbitrary, + liftM DBInteger arbitrary, + liftM DBList (sized list')] + where list' n = list'' 5 n + list'' 0 _ = return [] + list'' _ 0 = return [] + list'' n m = (:) <$> oneof [ liftM DBNone (return None), + liftM DBBool arbitrary, + liftM DBChar arbitrary, + liftM DBString arbitrary, + liftM DBInt arbitrary, + liftM DBInteger arbitrary, + liftM DBList (list'' n (m-1))] <*> list'' (n-1) m + +ruleInsertFind :: Key -> [DBData] -> Bool +ruleInsertFind k vs = + let ruleHelper key [] db = (findData key db) == DBNone None + ruleHelper key (x:[]) db = + let dbn = insertData key x db + xFind = (findData key dbn) + in xFind == x + ruleHelper key (x:xs) db = + let dbn = insertData key x db + xFind = (findData key dbn) + in xFind == x && ruleHelper key xs dbn + in + ruleHelper k vs initDB + +main :: IO () +main = quickCheck ruleInsertFind