zgo-backend/src/Order.hs

{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DuplicateRecordFields #-}

module Order 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

-- | Type to represent a ZGo order
data ZGoOrder =
  ZGoOrder
    { q_id :: Maybe ObjectId
    , qaddress :: T.Text
    , qsession :: T.Text
    , qtimestamp :: UTCTime
    , qclosed :: Bool
    , qcurrency :: T.Text
    , qprice :: Double
    , qtotal :: Double
    , qtotalZec :: Double
    , qlines :: [LineItem]
    }
  deriving (Eq, Show, Generic)

instance ToJSON ZGoOrder where
  toJSON (ZGoOrder i a s ts c cur p t tZ l) =
    case i of
      Just oid ->
        object
          [ "_id" .= show oid
          , "address" .= a
          , "session" .= s
          , "timestamp" .= ts
          , "closed" .= c
          , "currency" .= cur
          , "price" .= p
          , "total" .= t
          , "totalZec" .= tZ
          , "lines" .= l
          ]
      Nothing ->
        object
          [ "_id" .= ("" :: String)
          , "address" .= a
          , "session" .= s
          , "timestamp" .= ts
          , "closed" .= c
          , "currency" .= cur
          , "price" .= p
          , "total" .= t
          , "totalZec" .= tZ
          , "lines" .= l
          ]

instance FromJSON ZGoOrder where
  parseJSON =
    withObject "Order" $ \obj -> do
      i <- obj .: "_id"
      a <- obj .: "address"
      s <- obj .: "session"
      ts <- obj .: "timestamp"
      c <- obj .: "closed"
      cur <- obj .: "currency"
      p <- obj .: "price"
      t <- obj .: "total"
      tZ <- obj .: "totalZec"
      l <- obj .: "lines"
      pure $
        ZGoOrder
          (if not (null i)
             then Just (read i)
             else Nothing)
          a
          s
          ts
          c
          cur
          p
          t
          tZ
          l

instance Val ZGoOrder where
  val (ZGoOrder i a s ts c cur p t tZ l) =
    if isJust i
      then Doc
             [ "_id" =: i
             , "address" =: a
             , "session" =: s
             , "timestamp" =: ts
             , "closed" =: c
             , "currency" =: cur
             , "price" =: p
             , "total" =: t
             , "totalZec" =: tZ
             , "lines" =: l
             ]
      else Doc
             [ "address" =: a
             , "session" =: s
             , "timestamp" =: ts
             , "closed" =: c
             , "currency" =: cur
             , "price" =: p
             , "total" =: t
             , "totalZec" =: tZ
             , "lines" =: l
             ]
  cast' (Doc d) = do
    i <- B.lookup "_id" d
    a <- B.lookup "address" d
    s <- B.lookup "session" d
    ts <- B.lookup "timestamp" d
    c <- B.lookup "closed" d
    cur <- B.lookup "currency" d
    p <- B.lookup "price" d
    t <- B.lookup "total" d
    tZ <- B.lookup "totalZec" d
    l <- B.lookup "lines" d
    Just (ZGoOrder i a s ts c cur p t tZ l)
  cast' _ = Nothing

-- Type to represent an order line item
data LineItem =
  LineItem
    { l_id :: Maybe ObjectId
    , lqty :: Double
    , lname :: T.Text
    , lcost :: Double
    }
  deriving (Eq, Show)

instance ToJSON LineItem where
  toJSON (LineItem i q n c) =
    case i of
      Just oid ->
        object ["_id" .= show oid, "qty" .= q, "name" .= n, "cost" .= c]
      Nothing ->
        object ["_id" .= ("" :: String), "qty" .= q, "name" .= n, "cost" .= c]

instance FromJSON LineItem where
  parseJSON =
    withObject "LineItem" $ \obj -> do
      i <- obj .: "_id"
      q <- obj .: "qty"
      n <- obj .: "name"
      c <- obj .: "cost"
      pure $
        LineItem
          (if not (null i)
             then Just (read i)
             else Nothing)
          q
          n
          c

instance Val LineItem where
  val (LineItem i q n c) =
    case i of
      Just oid -> Doc ["_id" =: oid, "qty" =: q, "name" =: n, "cost" =: c]
      Nothing -> Doc ["qty" =: q, "name" =: n, "cost" =: c]
  cast' (Doc d) = do
    i <- B.lookup "_id" d
    q <- B.lookup "qty" d
    n <- B.lookup "name" d
    c <- B.lookup "cost" d
    Just (LineItem i q n c)
  cast' _ = Nothing

-- Database actions
upsertOrder :: ZGoOrder -> Action IO ()
upsertOrder o = do
  let order = val o
  case order of
    Doc d -> upsert (select ["_id" =: q_id o] "orders") d
    _ -> return ()

findOrder :: T.Text -> Action IO (Maybe Document)
findOrder s = findOne (select ["session" =: s] "orders")

findOrderById :: String -> Action IO (Maybe Document)
findOrderById i = findOne (select ["_id" =: (read i :: B.ObjectId)] "orders")

deleteOrder :: String -> Action IO ()
deleteOrder i = deleteOne (select ["_id" =: (read i :: B.ObjectId)] "orders")