[haskell] Implemented ship

9 files changed, 167 insertions, 8 deletions

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)