LambdaDB (empty) → 0.0.0.5

raw patch · 10 files changed

+327/−0 lines, 10 filesdep +LambdaDBdep +basedep +containerssetup-changed

Dependencies added: LambdaDB, base, containers, transformers

Files

LICENSE +30/−0
LambdaDB.cabal +47/−0
Setup.hs +2/−0
app/Main.hs +9/−0
src/Database/LambdaDB.hs +13/−0
src/Database/LambdaDB/Command.hs +40/−0
src/Database/LambdaDB/DBType.hs +26/−0
src/Database/LambdaDB/DataType.hs +101/−0
src/Lib.hs +57/−0
test/Spec.hs +2/−0

+ LICENSE view

@@ -0,0 +1,30 @@+Copyright Junyoung Clare Jang (c) 2016++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 Junyoung Clare Jang 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.

+ LambdaDB.cabal view

@@ -0,0 +1,47 @@+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

+ Setup.hs view

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

+ app/Main.hs view

@@ -0,0 +1,9 @@+module Main where++import Lib++main :: IO ()+main = do+  d <- dbInit+  dbProc d+  dbTerm

+ src/Database/LambdaDB.hs view

@@ -0,0 +1,13 @@+module Database.LambdaDB
+  ( Command(..),
+    DB(..),
+    DBData(..),
+    Key,
+    initDB,
+    insertData,
+    findData
+  ) where
+
+import Database.LambdaDB.DataType
+import Database.LambdaDB.DBType
+import Database.LambdaDB.Command

+ src/Database/LambdaDB/Command.hs view

@@ -0,0 +1,40 @@+module Database.LambdaDB.Command
+  ( Command(..)
+  ) where
+
+import Data.Char
+
+import Database.LambdaDB.DataType
+
+data Command = ComError
+             | ComQuit
+             | ComStatus
+             | ComInsert Key DBData
+             | ComFind Key
+             deriving (Show)
+
+instance Read Command where
+  readsPrec d r =
+    readParen (d > app_prec)
+    (\x -> [(ComQuit, t) |
+            (s, t) <- lex x,
+            "quit" <- [map toLower s]]) r
+    ++
+    readParen (d > app_prec)
+    (\x -> [(ComStatus, t) |
+            (s, t) <- lex x,
+            "status" <- [map toLower s]]) r
+    ++
+    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)
+    (\x -> [(ComFind k, u) |
+             (s, t) <- lex x,
+             "find" <- [map toLower s],
+             (k, u) <- lex t]) r
+    where app_prec = 10

+ src/Database/LambdaDB/DBType.hs view

@@ -0,0 +1,26 @@+module Database.LambdaDB.DBType
+  (
+    DB(..),
+    initDB,
+    insertData,
+    findData
+  ) where
+
+-- Custom Libraries
+import Database.LambdaDB.DataType
+
+data DB = Lambda {unLambda::Key -> DBData}
+
+initDB :: DB
+initDB = Lambda
+         $ (\_ -> DBNone None)
+
+insertData :: Key -> DBData -> DB -> DB
+insertData key value db = Lambda
+                          $ \x -> if (x == key) then
+                                    value
+                                  else
+                                    unLambda db key
+
+findData :: Key -> DB -> DBData
+findData key db = unLambda db key

+ src/Database/LambdaDB/DataType.hs view

@@ -0,0 +1,101 @@+module Database.LambdaDB.DataType
+  ( None(..),
+    DBData(..),
+    Key
+  ) where
+
+-- Hackage Libraries
+import Data.Set
+
+data None = None deriving (Eq, Ord, Show, Read)
+
+data DBData = DBNone None
+            | DBBool Bool
+            | DBChar Char
+            | DBString String
+            | DBInt Int
+            | DBInteger Integer
+            | DBList ([DBData])
+            | DBSet (Set DBData)
+            deriving (Eq, Ord)
+
+instance Read DBData where
+  readsPrec d r =
+    readParen (d > app_prec)
+    (\x -> [(DBNone None, t) |
+            ("None", t) <- lex x]) r
+    ++ readParen (d > app_prec)
+    (\x -> [(DBBool b, t) |
+            (b, t) <- readsPrec (app_prec + 1) x]) r
+    ++ readParen (d > app_prec)
+    (\x -> [(DBChar c, t) |
+            (c, t) <- readsPrec (app_prec + 1) x]) r
+    ++ readParen (d > app_prec)
+    (\x -> [(DBString s, t) |
+            (s, t) <- readsPrec (app_prec + 1) x]) r
+    ++ readParen (d > app_prec)
+    (\x -> [(DBInt i, t) |
+            (i, t) <- readsPrec (app_prec + 1) x]) r
+    ++ readParen (d > app_prec)
+    (\x -> [(DBInteger ii, t) |
+            (ii, s) <- readsPrec (app_prec + 1) x,
+            ("i", t) <- lex s]) r
+    ++ readParen (d > app_prec)
+    (\x -> [(DBList l, t) |
+            (l, t) <- readsPrec (app_prec + 1) x]) r
+    where app_prec = 10
+
+instance Show DBData where
+  showsPrec d r = case r of
+    DBNone None -> showString "None"
+    DBBool b -> showsPrec d b
+    DBChar c -> showsPrec d c
+    DBInt i -> showsPrec d i
+    DBInteger ii -> showParen (d > app_prec)
+                    $ showsPrec (app_prec+1) ii . showString "i"
+    DBList l -> showsPrec d l
+    DBSet s -> showsPrec d s
+    where app_prec = 10
+
+type Key = String
+
+-- Is this needed?
+class (Eq a, Read a, Show a) => DataType a where
+  defaultValue :: a
+  toDBData :: a -> DBData
+  fromDBData :: DBData -> a
+
+instance DataType None where
+  defaultValue = None
+  toDBData = DBNone
+  fromDBData (DBNone _) = None
+
+instance DataType Bool where
+  defaultValue = True
+  toDBData = DBBool
+  fromDBData (DBBool x) = x
+
+instance DataType Char where
+  defaultValue = '\0'
+  toDBData = DBChar
+  fromDBData (DBChar x) = x
+
+instance DataType Int where
+  defaultValue = 0
+  toDBData = DBInt
+  fromDBData (DBInt x) = x
+
+instance DataType Integer where
+  defaultValue = 0
+  toDBData = DBInteger
+  fromDBData (DBInteger x) = x
+
+instance (DataType a) => DataType [a] where
+  defaultValue = []
+  toDBData = DBList . fmap toDBData
+  fromDBData (DBList x) = fmap fromDBData x
+
+instance (DataType a, Ord a) => DataType (Set a) where
+  defaultValue = empty
+  toDBData = DBSet . Data.Set.map toDBData
+  fromDBData (DBSet x) = Data.Set.map fromDBData x

+ src/Lib.hs view

@@ -0,0 +1,57 @@+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"

+ test/Spec.hs view

@@ -0,0 +1,2 @@+main :: IO ()+main = putStrLn "Test suite not yet implemented"