106 lines
2.4 KiB
Haskell
106 lines
2.4 KiB
Haskell
{-# LANGUAGE OverloadedStrings #-}
|
|
{-# LANGUAGE DeriveGeneric #-}
|
|
{-# LANGUAGE DuplicateRecordFields #-}
|
|
|
|
module Item where
|
|
|
|
import Data.Aeson
|
|
import qualified Data.Bson as B
|
|
import Data.Maybe
|
|
import qualified Data.Text as T
|
|
import Data.Time.Clock
|
|
import Database.MongoDB
|
|
import GHC.Generics
|
|
import Test.QuickCheck
|
|
import User
|
|
|
|
-- | Type to represent a ZGo item
|
|
data Item =
|
|
Item
|
|
{ i_id :: Maybe ObjectId
|
|
, iname :: T.Text
|
|
, idescription :: T.Text
|
|
, iowner :: T.Text
|
|
, icost :: Double
|
|
}
|
|
deriving (Eq, Show, Generic)
|
|
|
|
instance ToJSON Item where
|
|
toJSON (Item i n d o c) =
|
|
case i of
|
|
Just oid ->
|
|
object
|
|
[ "_id" .= show oid
|
|
, "name" .= n
|
|
, "description" .= d
|
|
, "owner" .= o
|
|
, "cost" .= c
|
|
]
|
|
Nothing ->
|
|
object
|
|
[ "_id" .= ("" :: String)
|
|
, "name" .= n
|
|
, "description" .= d
|
|
, "owner" .= o
|
|
, "cost" .= c
|
|
]
|
|
|
|
instance FromJSON Item where
|
|
parseJSON =
|
|
withObject "Item" $ \obj -> do
|
|
i <- obj .: "_id"
|
|
n <- obj .: "name"
|
|
d <- obj .: "description"
|
|
o <- obj .: "owner"
|
|
c <- obj .: "cost"
|
|
pure $
|
|
Item
|
|
(if not (null i)
|
|
then Just (read i)
|
|
else Nothing)
|
|
n
|
|
d
|
|
o
|
|
c
|
|
|
|
instance Val Item where
|
|
val (Item i n d o c) =
|
|
if isJust i
|
|
then Doc
|
|
[ "_id" =: i
|
|
, "name" =: n
|
|
, "description" =: d
|
|
, "owner" =: o
|
|
, "cost" =: c
|
|
]
|
|
else Doc ["name" =: n, "description" =: d, "owner" =: o, "cost" =: c]
|
|
cast' (Doc d) = do
|
|
i <- B.lookup "_id" d
|
|
n <- B.lookup "name" d
|
|
d' <- B.lookup "description" d
|
|
o <- B.lookup "owner" d
|
|
c <- B.lookup "cost" d
|
|
Just (Item i n d' o c)
|
|
cast' _ = Nothing
|
|
|
|
-- Database actions
|
|
findItems :: T.Text -> Action IO [Document]
|
|
findItems a =
|
|
rest =<< find (select ["owner" =: a] "items") {sort = ["name" =: (1 :: Int)]}
|
|
|
|
findItemById :: String -> Action IO (Maybe Document)
|
|
findItemById i = findOne (select ["_id" =: (read i :: ObjectId)] "items")
|
|
|
|
upsertItem :: Item -> Action IO ()
|
|
upsertItem i = do
|
|
let item = val i
|
|
case item of
|
|
Doc d ->
|
|
if isJust (i_id i)
|
|
then upsert (select ["_id" =: i_id i] "items") d
|
|
else insert_ "items" d
|
|
_ -> return ()
|
|
|
|
deleteItem :: String -> Action IO ()
|
|
deleteItem i = deleteOne (select ["_id" =: (read i :: B.ObjectId)] "items")
|