[haskell] refactoring
This commit is contained in:
parent
d668eac4a6
commit
7e27a0a7ea
26 changed files with 289 additions and 311 deletions
|
@ -1,11 +1,10 @@
|
|||
{-# LANGUAGE OverloadedStrings #-}
|
||||
|
||||
module Main (main) where
|
||||
|
||||
import SpaceTraders
|
||||
import SpaceTraders.Automation.Init
|
||||
import SpaceTraders.APIClient.Agent
|
||||
import SpaceTraders.APIClient.Contracts
|
||||
import SpaceTraders.APIClient.Ships
|
||||
import SpaceTraders.APIClient.Systems
|
||||
import SpaceTraders.Automation.Init
|
||||
|
||||
main :: IO ()
|
||||
main = do
|
||||
|
@ -15,7 +14,11 @@ main = do
|
|||
where
|
||||
main' :: SpaceTradersT ()
|
||||
main' = do
|
||||
_ <- initSystems
|
||||
-- refresh our core objects
|
||||
_ <- myAgent
|
||||
_ <- myContracts
|
||||
(Right ships) <- myShips -- work around to fetch the initial probe
|
||||
_ <- orbit (head ships)
|
||||
let cmdShip = head ships
|
||||
(Right t) <- orbit cmdShip
|
||||
liftIO $ print t
|
||||
return ()
|
||||
|
|
|
@ -1,6 +1,3 @@
|
|||
{-# LANGUAGE NumericUnderscores #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
|
||||
module SpaceTraders
|
||||
( SpaceTradersT
|
||||
, microSinceEpoch
|
||||
|
|
|
@ -10,18 +10,23 @@ module SpaceTraders.APIClient.Agent
|
|||
|
||||
import Control.Monad.Reader
|
||||
import Data.Aeson
|
||||
import GHC.Generics
|
||||
import qualified Data.Text as T
|
||||
import GHC.Generics
|
||||
import Network.HTTP.Simple
|
||||
|
||||
import SpaceTraders
|
||||
import SpaceTraders.APIClient.Client
|
||||
import SpaceTraders.Model.Agent(Agent)
|
||||
import SpaceTraders.Model.Ship(Ship)
|
||||
import SpaceTraders.Database.Agents
|
||||
import SpaceTraders.Model.Agent (Agent)
|
||||
import SpaceTraders.Model.Contract
|
||||
import SpaceTraders.Model.Ship (Ship)
|
||||
|
||||
myAgent :: SpaceTradersT (APIResponse Agent)
|
||||
myAgent = send $ setRequestPath "/v2/my/agent"
|
||||
myAgent = do
|
||||
a@(Right ag) <- send $ setRequestPath "/v2/my/agent"
|
||||
setAgent ag
|
||||
return a
|
||||
|
||||
|
||||
data RegisterRequest = RegisterRequest { faction :: T.Text
|
||||
, symbol :: T.Text
|
||||
|
|
|
@ -29,7 +29,7 @@ import SpaceTraders.APIClient.Errors
|
|||
import SpaceTraders.APIClient.Pagination
|
||||
import SpaceTraders.Utils
|
||||
|
||||
data FromJSON a => APIMessage a = APIMessage { messageData :: a
|
||||
data APIMessage a = APIMessage { messageData :: a
|
||||
, messagePagination :: Maybe Pagination
|
||||
} deriving (Show)
|
||||
instance FromJSON a => FromJSON (APIMessage a) where
|
||||
|
@ -45,7 +45,7 @@ defaultReq = setRequestHost "api.spacetraders.io"
|
|||
$ setRequestPort 443
|
||||
$ setRequestSecure True
|
||||
$ setRequestHeader "Content-Type" ["application/json"]
|
||||
$ defaultRequest
|
||||
defaultRequest
|
||||
|
||||
tokenReq :: T.Text -> Request
|
||||
tokenReq token = setRequestHeader "Authorization" [T.encodeUtf8 $ "Bearer " <> token] defaultReq
|
||||
|
@ -63,7 +63,7 @@ sendPaginated pagination requestBuilder = do
|
|||
let request = requestBuilder $ getRequest env
|
||||
request' = case pagination of
|
||||
Just myPage -> setRequestQueryString [("limit", Just . int2ByteString $ limit myPage), ("page", Just . int2ByteString $ page myPage)]
|
||||
$ request
|
||||
request
|
||||
Nothing -> request
|
||||
sendPaginated' request'
|
||||
where
|
||||
|
@ -82,12 +82,12 @@ sendPaginated pagination requestBuilder = do
|
|||
body = getResponseBody response
|
||||
if status >= 200 && status <= 299
|
||||
then case eitherDecode body of
|
||||
Left e -> return . Left $ APIError (-1000) (T.pack $ concat ["Error decoding JSON APIMessage: ", e]) Null
|
||||
Left e -> return . Left $ APIError (-1000) (T.pack $ "Error decoding JSON APIMessage: " ++ e) Null
|
||||
Right r -> return $ Right r
|
||||
else case eitherDecode body of
|
||||
Left e -> return . Left $ APIError (-status) (T.pack $ concat ["Error decoding JSON APIError: ", e, ". Got HTTP body: ", show body]) Null
|
||||
Right (APIRateLimit r) -> do
|
||||
liftIO $ delay (1_000_000 * (round $ retryAfter r))
|
||||
liftIO $ delay (1_000_000 * round (retryAfter r))
|
||||
sendPaginated' request
|
||||
Right (APIResetHappened _) -> liftIO $ do
|
||||
removeFile "spacetraders.db"
|
||||
|
|
|
@ -1,5 +1,3 @@
|
|||
{-# LANGUAGE DeriveAnyClass #-}
|
||||
{-# LANGUAGE DeriveGeneric #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
|
||||
module SpaceTraders.APIClient.Contracts
|
||||
|
@ -12,7 +10,7 @@ import SpaceTraders
|
|||
import SpaceTraders.APIClient.Client
|
||||
import SpaceTraders.APIClient.Pagination
|
||||
import SpaceTraders.Database.Contracts
|
||||
import SpaceTraders.Model.Contract(Contract)
|
||||
import SpaceTraders.Model.Contract (Contract)
|
||||
|
||||
myContracts :: SpaceTradersT (APIResponse [Contract])
|
||||
myContracts = do
|
||||
|
@ -25,6 +23,6 @@ myContracts = do
|
|||
Left e -> return $ Left e
|
||||
Right (APIMessage r (Just p')) -> do
|
||||
mapM_ setContract r
|
||||
if (limit p' * page p' < total p') then listContracts' (nextPage p')
|
||||
if limit p' * page p' < total p' then listContracts' (nextPage p')
|
||||
else Right <$> getContracts
|
||||
_ -> undefined
|
||||
|
|
|
@ -10,8 +10,8 @@ module SpaceTraders.APIClient.Errors
|
|||
|
||||
import Control.Exception
|
||||
import Data.Aeson
|
||||
import Data.Time
|
||||
import qualified Data.Text as T
|
||||
import Data.Time
|
||||
import GHC.Generics
|
||||
|
||||
data APIError = APIError Int T.Text Value
|
||||
|
@ -27,8 +27,7 @@ instance FromJSON APIError where
|
|||
case code of
|
||||
401 -> APIResetHappened <$> parseJSON d
|
||||
429 -> APIRateLimit <$> parseJSON d
|
||||
_ -> APIError <$> pure code
|
||||
<*> e .: "message"
|
||||
_ -> APIError code <$> e .: "message"
|
||||
<*> pure d
|
||||
|
||||
data RateLimit = RateLimit { limitBurst :: Int
|
||||
|
|
|
@ -1,6 +1,5 @@
|
|||
{-# LANGUAGE DeriveAnyClass #-}
|
||||
{-# LANGUAGE DeriveGeneric #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
|
||||
module SpaceTraders.APIClient.Pagination
|
||||
( Pagination(..)
|
||||
|
|
|
@ -20,7 +20,8 @@ import SpaceTraders.Database.Ships
|
|||
import SpaceTraders.Model.Nav
|
||||
import SpaceTraders.Model.Ship
|
||||
|
||||
data NavMessage = NavMessage { nav :: Nav } deriving (FromJSON, Generic, Show)
|
||||
newtype NavMessage = NavMessage { nav :: Nav } deriving (FromJSON, Generic, Show)
|
||||
|
||||
dock :: Ship -> SpaceTradersT (APIResponse Ship)
|
||||
dock ship = do
|
||||
resp <- send $ setRequestPath (T.encodeUtf8 $ mconcat ["/v2/my/ships/", symbol ship, "/dock"])
|
||||
|
@ -29,7 +30,7 @@ dock ship = do
|
|||
Left e -> return $ Left e
|
||||
Right (NavMessage n) -> do
|
||||
let s = ship{SpaceTraders.Model.Ship.nav=n}
|
||||
updateShip s
|
||||
setShip s
|
||||
return $ Right s
|
||||
|
||||
myShips :: SpaceTradersT (APIResponse [Ship])
|
||||
|
@ -43,7 +44,7 @@ myShips = do
|
|||
Left e -> return $ Left e
|
||||
Right (APIMessage r (Just p')) -> do
|
||||
mapM_ setShip r
|
||||
if (limit p' * page p' < total p') then listShips' (nextPage p')
|
||||
if limit p' * page p' < total p' then listShips' (nextPage p')
|
||||
else Right <$> getShips
|
||||
_ -> undefined
|
||||
|
||||
|
@ -55,5 +56,5 @@ orbit ship = do
|
|||
Left e -> return $ Left e
|
||||
Right (NavMessage n) -> do
|
||||
let s = ship{SpaceTraders.Model.Ship.nav=n}
|
||||
updateShip s
|
||||
setShip s
|
||||
return $ Right s
|
||||
|
|
|
@ -1,5 +1,3 @@
|
|||
{-# LANGUAGE DeriveAnyClass #-}
|
||||
{-# LANGUAGE DeriveGeneric #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
|
||||
module SpaceTraders.APIClient.Systems
|
||||
|
@ -13,12 +11,12 @@ import SpaceTraders
|
|||
import SpaceTraders.APIClient.Client
|
||||
import SpaceTraders.APIClient.Pagination
|
||||
import SpaceTraders.Database.Systems
|
||||
import SpaceTraders.Model.System(System)
|
||||
import SpaceTraders.Model.System (System)
|
||||
|
||||
initSystems :: SpaceTradersT (APIResponse [System])
|
||||
initSystems = do
|
||||
s <- getSystems
|
||||
listSystems' Pagination{limit=20, page=((length s) `div` 20) + 1, total=0}
|
||||
listSystems' Pagination{limit=20, page=(length s `div` 20) + 1, total=0}
|
||||
where
|
||||
listSystems' :: Pagination -> SpaceTradersT (APIResponse [System])
|
||||
listSystems' p = do
|
||||
|
@ -27,6 +25,6 @@ initSystems = do
|
|||
Left e -> throw e
|
||||
Right (APIMessage r (Just p')) -> do
|
||||
addSystems r
|
||||
if (limit p' * page p' < total p') then listSystems' (nextPage p')
|
||||
if limit p' * page p' < total p' then listSystems' (nextPage p')
|
||||
else Right <$> getSystems
|
||||
_ -> undefined
|
||||
|
|
|
@ -6,9 +6,10 @@ module SpaceTraders.Automation.Init
|
|||
) where
|
||||
|
||||
import Control.Exception
|
||||
import Control.Monad.Error.Class
|
||||
import Control.Monad.Reader
|
||||
import qualified Database.SQLite.Simple as S
|
||||
import qualified Data.Text as T
|
||||
import qualified Database.SQLite.Simple as S
|
||||
import System.Directory
|
||||
|
||||
import SpaceTraders
|
||||
|
@ -30,7 +31,7 @@ deinitST env = do
|
|||
initST :: IO Env
|
||||
initST = do
|
||||
conn <- open
|
||||
t <- runReaderT getToken conn `catch` handleNoToken conn
|
||||
t <- runReaderT getToken conn `catchError` handleNoToken conn
|
||||
env <- newEnv conn (tokenReq t)
|
||||
ma <- runReaderT getAgent conn -- We compare the agent state in the database
|
||||
ma' <- runSpaceTradersT myAgent env -- with the one on the servers
|
||||
|
@ -42,21 +43,21 @@ initST = do
|
|||
_ <- runReaderT myContracts env -- refresh contracts
|
||||
_ <- runReaderT myShips env -- refresh ships
|
||||
runReaderT (setAgent ma'') conn -- store the fresh agent state
|
||||
return $ env
|
||||
return env
|
||||
where
|
||||
handleNoToken :: S.Connection -> SomeException -> IO T.Text
|
||||
handleNoToken :: S.Connection -> IOException -> IO T.Text
|
||||
handleNoToken conn _ = newEnv conn defaultReq >>= runReaderT registerST
|
||||
|
||||
registerST :: SpaceTradersT (T.Text)
|
||||
registerST :: SpaceTradersT T.Text
|
||||
registerST = do
|
||||
r <- register "ADYXAX-HS" "COSMIC"
|
||||
r <- register "ADYXAX-HS-6" "COSMIC"
|
||||
case r of
|
||||
Right r' -> do
|
||||
let t = token r'
|
||||
addToken t
|
||||
addAgent $ agent r'
|
||||
addContract $ contract r'
|
||||
addShip $ ship r'
|
||||
setAgent $ agent r'
|
||||
setContract $ contract r'
|
||||
setShip $ ship r'
|
||||
return t
|
||||
Left e' -> throw e'
|
||||
|
||||
|
|
|
@ -10,15 +10,15 @@ module SpaceTraders.Database
|
|||
import Control.Exception
|
||||
import qualified Data.ByteString as B
|
||||
import Data.FileEmbed
|
||||
import qualified Database.SQLite.Simple as S
|
||||
import qualified Data.Text as T
|
||||
import qualified Data.Text.Encoding as T
|
||||
import qualified Database.SQLite.Simple as S
|
||||
|
||||
migrations :: [B.ByteString]
|
||||
migrations = [ $(embedFile "src/SpaceTraders/Database/000_init.sql") ]
|
||||
|
||||
close :: S.Connection -> IO ()
|
||||
close conn = S.close conn
|
||||
close = S.close
|
||||
|
||||
open :: IO S.Connection
|
||||
open = do
|
||||
|
@ -27,7 +27,7 @@ open = do
|
|||
S.execute_ conn "PRAGMA journal_mode = WAL;"
|
||||
S.withTransaction conn $ do
|
||||
version <- getSchemaVersion conn `catch` defaultVersion
|
||||
mapM_ (S.execute_ conn) $ S.Query <$> (filter (/= "\n") . concat . map ((T.splitOn ";") . T.decodeUtf8) $ drop version migrations)
|
||||
mapM_ (S.execute_ conn) $ S.Query <$> concatMap (filter (/= "\n") . T.splitOn ";" . T.decodeUtf8) (drop version migrations)
|
||||
S.execute_ conn "DELETE FROM schema_version;"
|
||||
S.execute conn "INSERT INTO schema_version (version) VALUES (?);" (S.Only $ length migrations)
|
||||
return conn
|
||||
|
|
|
@ -1,11 +1,11 @@
|
|||
{-# LANGUAGE OverloadedStrings #-}
|
||||
|
||||
module SpaceTraders.Database.Agents
|
||||
( addAgent
|
||||
, getAgent
|
||||
( getAgent
|
||||
, setAgent
|
||||
) where
|
||||
|
||||
import Control.Monad.Error.Class
|
||||
import Control.Monad.Reader
|
||||
import Data.Aeson
|
||||
import qualified Database.SQLite.Simple as S
|
||||
|
@ -14,11 +14,11 @@ import SpaceTraders
|
|||
import SpaceTraders.Model.Agent
|
||||
import SpaceTraders.Utils
|
||||
|
||||
addAgent :: (HasDatabaseConn env, MonadIO m, MonadReader env m) => Agent -> m ()
|
||||
addAgent agent = execute "INSERT INTO agents(data) VALUES (json(?));" (S.Only (encode agent))
|
||||
|
||||
getAgent :: (HasDatabaseConn env, MonadIO m, MonadReader env m) => m Agent
|
||||
getAgent = one_ "SELECT data FROM agents";
|
||||
getAgent = one_ "SELECT data FROM agents"; -- we only support one agent at a time
|
||||
|
||||
setAgent :: (HasDatabaseConn env, MonadIO m, MonadReader env m) => Agent -> m ()
|
||||
setAgent agent = execute "UPDATE agents SET data = json(?);" (S.Only (encode agent))
|
||||
setAgent :: (HasDatabaseConn env, MonadError e m, MonadIO m, MonadReader env m) => Agent -> m ()
|
||||
setAgent agent = updateAgent `catchError` addAgent
|
||||
where
|
||||
addAgent _ = execute "INSERT INTO agents(data) VALUES (json(?));" (S.Only $ encode agent)
|
||||
updateAgent = execute "UPDATE agents SET data = json(?);" (S.Only (encode agent))
|
||||
|
|
|
@ -1,12 +1,11 @@
|
|||
{-# LANGUAGE OverloadedStrings #-}
|
||||
|
||||
module SpaceTraders.Database.Contracts
|
||||
( addContract
|
||||
, getContracts
|
||||
( getContracts
|
||||
, setContract
|
||||
, updateContract
|
||||
) where
|
||||
|
||||
import Control.Monad.Error.Class
|
||||
import Control.Monad.Reader
|
||||
import Data.Aeson
|
||||
import qualified Database.SQLite.Simple as S
|
||||
|
@ -15,17 +14,11 @@ import SpaceTraders
|
|||
import SpaceTraders.Model.Contract
|
||||
import SpaceTraders.Utils
|
||||
|
||||
addContract :: (HasDatabaseConn env, MonadIO m, MonadReader env m) => Contract -> m ()
|
||||
addContract contract = execute "INSERT INTO contracts(data) VALUES (json(?));" (S.Only (encode contract))
|
||||
|
||||
getContracts :: (HasDatabaseConn env, MonadIO m, MonadReader env m) => m [Contract]
|
||||
getContracts = query_ "SELECT data FROM contracts;"
|
||||
|
||||
setContract :: (HasDatabaseConn env, MonadFail m, MonadIO m, MonadReader env m) => Contract -> m ()
|
||||
setContract contract = do
|
||||
c <- count "SELECT count(id) FROM contracts WHERE data->>'contractId' = ?;" (S.Only $ contractId contract)
|
||||
if c == 0 then addContract contract
|
||||
else updateContract contract
|
||||
|
||||
updateContract :: (HasDatabaseConn env, MonadIO m, MonadReader env m) => Contract -> m ()
|
||||
updateContract contract = execute "UPDATE contracts SET data = json(?) WHERE data->>'contractId' = ?;" (encode contract, contractId contract)
|
||||
setContract :: (HasDatabaseConn env, MonadError e m, MonadIO m, MonadReader env m) => Contract -> m ()
|
||||
setContract contract = updateContract `catchError` addContract
|
||||
where
|
||||
addContract _ = execute "INSERT INTO contracts(data) VALUES (json(?));" (S.Only (encode contract))
|
||||
updateContract = execute "UPDATE contracts SET data = json(?) WHERE data->>'contractId' = ?;" (encode contract, contractId contract)
|
||||
|
|
|
@ -1,12 +1,11 @@
|
|||
{-# LANGUAGE OverloadedStrings #-}
|
||||
|
||||
module SpaceTraders.Database.Ships
|
||||
( addShip
|
||||
, getShips
|
||||
( getShips
|
||||
, setShip
|
||||
, updateShip
|
||||
) where
|
||||
|
||||
import Control.Monad.Error.Class
|
||||
import Control.Monad.Reader
|
||||
import Data.Aeson
|
||||
import qualified Database.SQLite.Simple as S
|
||||
|
@ -15,17 +14,11 @@ import SpaceTraders
|
|||
import SpaceTraders.Model.Ship
|
||||
import SpaceTraders.Utils
|
||||
|
||||
addShip :: (HasDatabaseConn env, MonadIO m, MonadReader env m) => Ship -> m ()
|
||||
addShip ship = execute "INSERT INTO ships(data) VALUES (json(?));" (S.Only $ encode ship)
|
||||
|
||||
getShips :: (HasDatabaseConn env, MonadIO m, MonadReader env m) => m [Ship]
|
||||
getShips = query_ "SELECT data FROM ships;"
|
||||
|
||||
setShip :: (HasDatabaseConn env, MonadFail m, MonadIO m, MonadReader env m) => Ship -> m ()
|
||||
setShip ship = do
|
||||
c <- count "SELECT count(id) FROM ships WHERE data->>'symbol' = ?;" (S.Only $ symbol ship)
|
||||
if c == 0 then addShip ship
|
||||
else updateShip ship
|
||||
|
||||
updateShip :: (HasDatabaseConn env, MonadIO m, MonadReader env m) => Ship -> m ()
|
||||
updateShip ship = execute "UPDATE ships SET data = json(?) WHERE data->>'symbol' = ?;" (encode ship, symbol ship)
|
||||
setShip :: (HasDatabaseConn env, MonadError e m, MonadIO m, MonadReader env m) => Ship -> m ()
|
||||
setShip ship = updateShip `catchError` addShip
|
||||
where
|
||||
addShip _ = execute "INSERT INTO ships(data) VALUES (json(?));" (S.Only $ encode ship)
|
||||
updateShip = execute "UPDATE ships SET data = json(?) WHERE data->>'symbol' = ?;" (encode ship, symbol ship)
|
||||
|
|
|
@ -1,5 +1,4 @@
|
|||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE QuasiQuotes #-}
|
||||
|
||||
module SpaceTraders.Database.Tokens
|
||||
( addToken
|
||||
|
@ -7,15 +6,14 @@ module SpaceTraders.Database.Tokens
|
|||
) where
|
||||
|
||||
import Control.Monad.Reader
|
||||
import qualified Database.SQLite.Simple as S
|
||||
import qualified Data.Text as T
|
||||
import qualified Database.SQLite.Simple as S
|
||||
|
||||
import SpaceTraders
|
||||
import SpaceTraders.Utils
|
||||
|
||||
addToken :: (HasDatabaseConn env, MonadIO m, MonadReader env m) => T.Text -> m ()
|
||||
addToken value = do
|
||||
env <- ask
|
||||
liftIO $ S.execute (getConn env) "INSERT INTO tokens(data) VALUES (?);" (S.Only value)
|
||||
addToken value = execute "INSERT INTO tokens(data) VALUES (?);" (S.Only value)
|
||||
|
||||
getToken :: (HasDatabaseConn env, MonadFail m, MonadIO m, MonadReader env m) => m T.Text
|
||||
getToken = do
|
||||
|
|
|
@ -1,14 +1,13 @@
|
|||
{-# LANGUAGE DeriveAnyClass #-}
|
||||
{-# LANGUAGE DeriveGeneric #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
|
||||
module SpaceTraders.Model.Agent
|
||||
( Agent(..)
|
||||
) where
|
||||
|
||||
import Data.Aeson
|
||||
import GHC.Generics
|
||||
import qualified Data.Text as T
|
||||
import GHC.Generics
|
||||
|
||||
data Agent = Agent { accountId :: T.Text
|
||||
, credits :: Integer
|
||||
|
|
|
@ -1,6 +1,5 @@
|
|||
{-# LANGUAGE DeriveAnyClass #-}
|
||||
{-# LANGUAGE DeriveGeneric #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
|
||||
module SpaceTraders.Model.Cargo
|
||||
( Cargo(..)
|
||||
|
@ -9,7 +8,7 @@ module SpaceTraders.Model.Cargo
|
|||
import Data.Aeson
|
||||
import GHC.Generics
|
||||
|
||||
import SpaceTraders.Model.Inventory(Inventory)
|
||||
import SpaceTraders.Model.Inventory (Inventory)
|
||||
|
||||
data Cargo = Cargo { capacity :: Int
|
||||
, inventory :: [Inventory]
|
||||
|
|
|
@ -1,6 +1,5 @@
|
|||
{-# LANGUAGE DeriveAnyClass #-}
|
||||
{-# LANGUAGE DeriveGeneric #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
|
||||
module SpaceTraders.Model.Fuel
|
||||
( Consumed(..)
|
||||
|
|
|
@ -1,14 +1,13 @@
|
|||
{-# LANGUAGE DeriveAnyClass #-}
|
||||
{-# LANGUAGE DeriveGeneric #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
|
||||
module SpaceTraders.Model.Inventory
|
||||
( Inventory(..)
|
||||
) where
|
||||
|
||||
import Data.Aeson
|
||||
import GHC.Generics
|
||||
import qualified Data.Text as T
|
||||
import GHC.Generics
|
||||
|
||||
data Inventory = Inventory { description :: T.Text
|
||||
, name :: T.Text
|
||||
|
|
|
@ -1,14 +1,13 @@
|
|||
{-# 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 GHC.Generics
|
||||
|
||||
import SpaceTraders.Model.Route
|
||||
|
||||
|
|
|
@ -1,14 +1,13 @@
|
|||
{-# 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 GHC.Generics
|
||||
|
||||
import SpaceTraders.Model.Cargo
|
||||
import SpaceTraders.Model.Fuel
|
||||
|
|
|
@ -1,4 +1,3 @@
|
|||
{-# LANGUAGE DeriveAnyClass #-}
|
||||
{-# LANGUAGE DeriveGeneric #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
|
||||
|
@ -10,7 +9,7 @@ import Data.Aeson
|
|||
import qualified Data.Text as T
|
||||
import GHC.Generics
|
||||
|
||||
import SpaceTraders.Model.Waypoint(Waypoint)
|
||||
import SpaceTraders.Model.Waypoint (Waypoint)
|
||||
|
||||
data System = System { sectorSymbol :: T.Text
|
||||
, symbol :: T.Text
|
||||
|
|
|
@ -1,4 +1,3 @@
|
|||
{-# LANGUAGE DeriveAnyClass #-}
|
||||
{-# LANGUAGE DeriveGeneric #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
|
||||
|
|
|
@ -43,16 +43,16 @@ int2ByteString :: Int -> B.ByteString
|
|||
int2ByteString = B.pack . map B.c2w . show
|
||||
|
||||
one_ :: (FromJSON b, HasDatabaseConn env, MonadReader env m, MonadIO m) => S.Query -> m b
|
||||
one_ q = query_ q >>= pure . head
|
||||
one_ q = head <$> query_ q
|
||||
|
||||
query :: (FromJSON b, HasDatabaseConn env, MonadReader env m, MonadIO m, S.ToRow t) => S.Query -> t -> m [b]
|
||||
query q t = do
|
||||
env <- ask
|
||||
ret <- liftIO $ S.query (getConn env) q t
|
||||
return . catMaybes $ map (decodeText . head) ret
|
||||
return $ mapMaybe (decodeText . head) ret
|
||||
|
||||
query_ :: (FromJSON b, HasDatabaseConn env, MonadReader env m, MonadIO m) => S.Query -> m [b]
|
||||
query_ q = do
|
||||
env <- ask
|
||||
ret <- liftIO $ S.query_ (getConn env) q
|
||||
return . catMaybes $ map (decodeText . head) ret
|
||||
return $ mapMaybe (decodeText . head) ret
|
||||
|
|
|
@ -17,8 +17,9 @@
|
|||
#
|
||||
# resolver: ./custom-snapshot.yaml
|
||||
# resolver: https://example.com/snapshots/2018-01-01.yaml
|
||||
resolver:
|
||||
url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/21/14.yaml
|
||||
#resolver: lts-22.13
|
||||
resolver: lts-21.25
|
||||
# url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/21/14.yaml
|
||||
|
||||
# User packages to be built.
|
||||
# Various formats can be used as shown in the example below.
|
||||
|
@ -49,7 +50,7 @@ packages:
|
|||
# extra-package-dbs: []
|
||||
|
||||
# Control whether we use the GHC we find on the path
|
||||
# system-ghc: true
|
||||
system-ghc: true
|
||||
#
|
||||
# Require a specific version of Stack, using version ranges
|
||||
# require-stack-version: -any # Default
|
||||
|
|
Loading…
Add table
Reference in a new issue