From 78c5467c4ac39869314c686d1d026482e7b3fd8f Mon Sep 17 00:00:00 2001 From: Julien Dessaux Date: Tue, 4 Jul 2023 19:37:50 +0200 Subject: [haskell] Implemented ship --- haskell/app/Main.hs | 2 ++ haskell/src/SpaceTraders/APIClient/Agent.hs | 2 ++ haskell/src/SpaceTraders/Database.hs | 17 ++++++------ haskell/src/SpaceTraders/Database/Ships.hs | 13 ++++++++++ haskell/src/SpaceTraders/Model/Cargo.hs | 17 ++++++++++++ haskell/src/SpaceTraders/Model/Fuel.hs | 21 +++++++++++++++ haskell/src/SpaceTraders/Model/Inventory.hs | 17 ++++++++++++ haskell/src/SpaceTraders/Model/Nav.hs | 20 +++++++++++++++ haskell/src/SpaceTraders/Model/Route.hs | 40 +++++++++++++++++++++++++++++ haskell/src/SpaceTraders/Model/Ship.hs | 28 ++++++++++++++++++++ 10 files changed, 169 insertions(+), 8 deletions(-) create mode 100644 haskell/src/SpaceTraders/Database/Ships.hs create mode 100644 haskell/src/SpaceTraders/Model/Cargo.hs create mode 100644 haskell/src/SpaceTraders/Model/Fuel.hs create mode 100644 haskell/src/SpaceTraders/Model/Inventory.hs create mode 100644 haskell/src/SpaceTraders/Model/Nav.hs create mode 100644 haskell/src/SpaceTraders/Model/Route.hs create mode 100644 haskell/src/SpaceTraders/Model/Ship.hs (limited to 'haskell') diff --git a/haskell/app/Main.hs b/haskell/app/Main.hs index 08e412d..76e4bef 100644 --- a/haskell/app/Main.hs +++ b/haskell/app/Main.hs @@ -10,6 +10,7 @@ import SpaceTraders.APIClient.Agent import SpaceTraders.Database import SpaceTraders.Database.Agents import SpaceTraders.Database.Contracts +import SpaceTraders.Database.Ships import SpaceTraders.Database.Tokens main :: IO () @@ -27,6 +28,7 @@ main = do Right r' -> do setAgent conn $ agent r' addContract conn $ contract r' + addShip conn $ ship r' let t = token r' setToken conn $ t return t diff --git a/haskell/src/SpaceTraders/APIClient/Agent.hs b/haskell/src/SpaceTraders/APIClient/Agent.hs index 6728baf..4ac550c 100644 --- a/haskell/src/SpaceTraders/APIClient/Agent.hs +++ b/haskell/src/SpaceTraders/APIClient/Agent.hs @@ -15,6 +15,7 @@ import Network.HTTP.Simple import SpaceTraders.APIClient.Client import SpaceTraders.Model.Agent +import SpaceTraders.Model.Ship(Ship) import SpaceTraders.Model.Contract myAgent :: T.Text -> IO (Either APIError Agent) @@ -26,6 +27,7 @@ data RegisterRequest = RegisterRequest { faction :: T.Text } deriving (ToJSON, Generic, Show) data RegisterMessage = RegisterMessage { agent :: Agent , contract :: Contract + , ship :: Ship , token :: T.Text } deriving (FromJSON, Generic, Show) diff --git a/haskell/src/SpaceTraders/Database.hs b/haskell/src/SpaceTraders/Database.hs index fdc32d3..ac3aa7b 100644 --- a/haskell/src/SpaceTraders/Database.hs +++ b/haskell/src/SpaceTraders/Database.hs @@ -14,23 +14,24 @@ migrations :: [S.Query] migrations = [ [r|CREATE TABLE schema_version ( version INTEGER NOT NULL - ); - |], + );|], [r|CREATE TABLE tokens ( id INTEGER PRIMARY KEY, data TEXT NOT NULL - ); - |], + );|], [r|CREATE TABLE agents ( id INTEGER PRIMARY KEY, data TEXT NOT NULL - ); - |], + );|], [r|CREATE TABLE contracts ( id INTEGER PRIMARY KEY, data TEXT NOT NULL - ); - |]] + );|], + [r|CREATE TABLE ships ( + id INTEGER PRIMARY KEY, + data TEXT NOT NULL + );|], + [r|CREATE UNIQUE INDEX ships_data_symbol ON ships (json_extract(data, '$.symbol'));|]] close :: S.Connection -> IO () close conn = S.close conn diff --git a/haskell/src/SpaceTraders/Database/Ships.hs b/haskell/src/SpaceTraders/Database/Ships.hs new file mode 100644 index 0000000..81c422d --- /dev/null +++ b/haskell/src/SpaceTraders/Database/Ships.hs @@ -0,0 +1,13 @@ +{-# LANGUAGE OverloadedStrings #-} + +module SpaceTraders.Database.Ships + ( addShip + ) where + +import Data.Aeson +import qualified Database.SQLite.Simple as S + +import SpaceTraders.Model.Ship + +addShip :: S.Connection -> Ship -> IO () +addShip conn ship = S.execute conn "INSERT INTO ships(data) VALUES (json(?));" (S.Only (encode ship)) diff --git a/haskell/src/SpaceTraders/Model/Cargo.hs b/haskell/src/SpaceTraders/Model/Cargo.hs new file mode 100644 index 0000000..126fc63 --- /dev/null +++ b/haskell/src/SpaceTraders/Model/Cargo.hs @@ -0,0 +1,17 @@ +{-# LANGUAGE DeriveAnyClass #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE OverloadedStrings #-} + +module SpaceTraders.Model.Cargo + ( Cargo(..) + ) where + +import Data.Aeson +import GHC.Generics + +import SpaceTraders.Model.Inventory(Inventory) + +data Cargo = Cargo { capacity :: Int + , inventory :: [Inventory] + , units :: Int + } deriving (FromJSON, Generic, Show, ToJSON) diff --git a/haskell/src/SpaceTraders/Model/Fuel.hs b/haskell/src/SpaceTraders/Model/Fuel.hs new file mode 100644 index 0000000..ca17ebb --- /dev/null +++ b/haskell/src/SpaceTraders/Model/Fuel.hs @@ -0,0 +1,21 @@ +{-# LANGUAGE DeriveAnyClass #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE OverloadedStrings #-} + +module SpaceTraders.Model.Fuel + ( Consumed(..) + , Fuel(..) + ) where + +import Data.Aeson +import Data.Time +import GHC.Generics + +data Consumed = Consumed { amount :: Int + , timestamp :: UTCTime + } deriving (FromJSON, Generic, Show, ToJSON) + +data Fuel = Fuel { capacity :: Int + , consumed :: Consumed + , current :: Int + } deriving (FromJSON, Generic, Show, ToJSON) diff --git a/haskell/src/SpaceTraders/Model/Inventory.hs b/haskell/src/SpaceTraders/Model/Inventory.hs new file mode 100644 index 0000000..db74ddb --- /dev/null +++ b/haskell/src/SpaceTraders/Model/Inventory.hs @@ -0,0 +1,17 @@ +{-# LANGUAGE DeriveAnyClass #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE OverloadedStrings #-} + +module SpaceTraders.Model.Inventory + ( Inventory(..) + ) where + +import Data.Aeson +import GHC.Generics +import qualified Data.Text as T + +data Inventory = Inventory { description :: T.Text + , name :: T.Text + , symbol :: T.Text + , units :: Int + } deriving (FromJSON, Generic, Show, ToJSON) diff --git a/haskell/src/SpaceTraders/Model/Nav.hs b/haskell/src/SpaceTraders/Model/Nav.hs new file mode 100644 index 0000000..1c23ca1 --- /dev/null +++ b/haskell/src/SpaceTraders/Model/Nav.hs @@ -0,0 +1,20 @@ +{-# LANGUAGE DeriveAnyClass #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE OverloadedStrings #-} + +module SpaceTraders.Model.Nav + ( Nav(..) + ) where + +import Data.Aeson +import GHC.Generics +import qualified Data.Text as T + +import SpaceTraders.Model.Route + +data Nav = Nav { flightMode :: T.Text + , route :: Route + , status :: T.Text + , systemSymbol :: T.Text + , waypointSymbol :: T.Text + } deriving (FromJSON, Generic, Show, ToJSON) diff --git a/haskell/src/SpaceTraders/Model/Route.hs b/haskell/src/SpaceTraders/Model/Route.hs new file mode 100644 index 0000000..959edff --- /dev/null +++ b/haskell/src/SpaceTraders/Model/Route.hs @@ -0,0 +1,40 @@ +{-# LANGUAGE DeriveAnyClass #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE OverloadedStrings #-} + +module SpaceTraders.Model.Route + ( Route(..) + , RouteEndpoint(..) + ) where + +import Control.Monad +import Data.Aeson +import Data.Time +import GHC.Generics +import qualified Data.Text as T + +data Route = Route { arrival :: UTCTime + , departure :: RouteEndpoint + , departureTime :: UTCTime + , destination :: RouteEndpoint + } deriving (FromJSON, Generic, Show, ToJSON) + +data RouteEndpoint = RouteEndpoint { routeEndpointType :: T.Text + , symbol :: T.Text + , systemSymbol :: T.Text + , x :: Int + , y :: Int + } deriving (Generic, Show) +instance FromJSON RouteEndpoint where + parseJSON (Object o) = RouteEndpoint <$> o .: "type" + <*> o .: "symbol" + <*> o .: "systemSymbol" + <*> o .: "x" + <*> o .: "y" + parseJSON _ = mzero +instance ToJSON RouteEndpoint where + toEncoding (RouteEndpoint t s ss xx yy) = pairs ( "type" .= t + <> "symbol" .= s + <> "systemSymbol" .= ss + <> "x" .= xx + <> "y" .= yy ) diff --git a/haskell/src/SpaceTraders/Model/Ship.hs b/haskell/src/SpaceTraders/Model/Ship.hs new file mode 100644 index 0000000..4228dca --- /dev/null +++ b/haskell/src/SpaceTraders/Model/Ship.hs @@ -0,0 +1,28 @@ +{-# LANGUAGE DeriveAnyClass #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE OverloadedStrings #-} + +module SpaceTraders.Model.Ship + ( Ship(..) + ) where + +import Data.Aeson +import GHC.Generics +import qualified Data.Text as T + +import SpaceTraders.Model.Cargo +import SpaceTraders.Model.Fuel +import SpaceTraders.Model.Nav + +data Ship = Ship { cargo :: Cargo + --, crew :: Crew + --, engine :: Engine + --, frame :: Frame + , fuel :: Fuel + --, modules :: [Module] + --, mounts :: [Mount] + , nav :: Nav + --, reactor :: Reactor + --, registration :: Registration + , symbol :: T.Text + } deriving (FromJSON, Generic, Show, ToJSON) -- cgit v1.2.3