summaryrefslogtreecommitdiff
path: root/haskell/src/SpaceTraders/Model/Contract.hs
blob: a0bebcccbee07810cd08e2a8d78fe0f86d3a3904 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE OverloadedStrings #-}

module SpaceTraders.Model.Contract
  ( Contract(..)
  , Delivery(..)
  , Payment(..)
  , Terms(..)
  ) where

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 = withObject "Contract" $ \o ->
    Contract <$> o .: "accepted"
             <*> o .: "id"
             <*> o .: "type"
             <*> o .: "expiration"
             <*> o .: "deadlineToAccept"
             <*> o .: "factionSymbol"
             <*> o .: "fulfilled"
             <*> o .: "terms"
instance ToJSON Contract where
  toJSON (Contract a i ty e d fa fu te) = object [ "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)