summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--haskell/app/Main.hs2
-rw-r--r--haskell/src/SpaceTraders/APIClient/Agent.hs2
-rw-r--r--haskell/src/SpaceTraders/Database.hs17
-rw-r--r--haskell/src/SpaceTraders/Database/Ships.hs13
-rw-r--r--haskell/src/SpaceTraders/Model/Cargo.hs17
-rw-r--r--haskell/src/SpaceTraders/Model/Fuel.hs21
-rw-r--r--haskell/src/SpaceTraders/Model/Inventory.hs17
-rw-r--r--haskell/src/SpaceTraders/Model/Nav.hs20
-rw-r--r--haskell/src/SpaceTraders/Model/Route.hs40
-rw-r--r--haskell/src/SpaceTraders/Model/Ship.hs28
10 files changed, 169 insertions, 8 deletions
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)
generated by cgit v1.2.3 (git 2.39.1) at 2024-11-22 02:17:54 +0000