From b3d57cb6adf1e3f6a8ba7cf1c1553b6fd4acb578 Mon Sep 17 00:00:00 2001 From: Julien Dessaux Date: Mon, 3 Jul 2023 21:29:15 +0200 Subject: [haskell] Implemented contract --- haskell/src/SpaceTraders/Model/Contract.hs | 60 ++++++++++++++++++++++++++++++ 1 file changed, 60 insertions(+) create mode 100644 haskell/src/SpaceTraders/Model/Contract.hs (limited to 'haskell/src/SpaceTraders/Model') diff --git a/haskell/src/SpaceTraders/Model/Contract.hs b/haskell/src/SpaceTraders/Model/Contract.hs new file mode 100644 index 0000000..fd7a70b --- /dev/null +++ b/haskell/src/SpaceTraders/Model/Contract.hs @@ -0,0 +1,60 @@ +{-# LANGUAGE DeriveAnyClass #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE OverloadedStrings #-} + +module SpaceTraders.Model.Contract + ( Contract(..) + , Delivery(..) + , Payment(..) + , Terms(..) + ) where + +import Control.Monad +import Data.Aeson +import Data.Time +import GHC.Generics +import qualified Data.Text as T + +data Contract = Contract { accepted :: Bool + , contractId :: T.Text + , contractType :: T.Text + , expiration :: UTCTime + , deadlineToAccept :: UTCTime + , factionSymbol :: T.Text + , fulfilled :: Bool + , terms :: Terms + } deriving (Generic, Show) +instance FromJSON Contract where + parseJSON (Object o) = Contract <$> o .: "accepted" + <*> o .: "id" + <*> o .: "type" + <*> o .: "expiration" + <*> o .: "deadlineToAccept" + <*> o .: "factionSymbol" + <*> o .: "fulfilled" + <*> o .: "terms" + parseJSON _ = mzero +instance ToJSON Contract where + toEncoding (Contract a i ty e d fa fu te) = pairs ( "accepted" .= a + <> "id" .= i + <> "type" .= ty + <> "expiration" .= e + <> "deadlineToAccept" .= d + <> "factionSymbol" .= fa + <> "fulfilled" .= fu + <> "terms" .= te ) + +data Delivery = Delivery { destinationSymbol :: T.Text + , tradeSymbol :: T.Text + , unitsFulfilled :: Int + , unitsRequired :: Int + } deriving (FromJSON, Generic, Show, ToJSON) + +data Payment = Payment { onAccepted :: Int + , onFulfilled :: Int + } deriving (FromJSON, Generic, Show, ToJSON) + +data Terms = Terms { deadline :: UTCTime + , deliver :: [Delivery] + , payment :: Payment + } deriving (FromJSON, Generic, Show, ToJSON) -- cgit v1.2.3