[haskell] refactoring
This commit is contained in:
parent
4af96da567
commit
15a7d5bef9
5 changed files with 26 additions and 24 deletions
|
@ -7,7 +7,6 @@ module SpaceTraders.APIClient.Client
|
|||
, APIPaginatedResponse
|
||||
, APIResponse
|
||||
, defaultReq
|
||||
, fromJSONValue
|
||||
, send
|
||||
, sendPaginated
|
||||
, tokenReq
|
||||
|
@ -16,9 +15,6 @@ module SpaceTraders.APIClient.Client
|
|||
import Control.Concurrent
|
||||
import Control.Monad.Reader
|
||||
import Data.Aeson
|
||||
import Data.Aeson.Types
|
||||
import qualified Data.ByteString as B
|
||||
import qualified Data.ByteString.Internal as B
|
||||
import qualified Data.Text as T
|
||||
import qualified Data.Text.Encoding as T
|
||||
import Network.HTTP.Simple
|
||||
|
@ -27,6 +23,7 @@ import Network.HTTP.Types.Status
|
|||
import SpaceTraders
|
||||
import SpaceTraders.APIClient.Errors
|
||||
import SpaceTraders.APIClient.Pagination
|
||||
import SpaceTraders.Utils
|
||||
|
||||
data FromJSON a => APIMessage a = APIMessage { messageData :: a
|
||||
, messagePagination :: Maybe Pagination
|
||||
|
@ -49,12 +46,6 @@ defaultReq = setRequestHost "api.spacetraders.io"
|
|||
tokenReq :: T.Text -> Request
|
||||
tokenReq token = setRequestHeader "Authorization" [T.encodeUtf8 $ "Bearer " <> token] defaultReq
|
||||
|
||||
fromJSONValue :: FromJSON a => Value -> Either String a
|
||||
fromJSONValue = parseEither parseJSON
|
||||
|
||||
int2ByteString :: Int -> B.ByteString
|
||||
int2ByteString = B.pack . map B.c2w . show
|
||||
|
||||
send :: (FromJSON a, HasRequest env, MonadIO m, MonadReader env m) => (Request -> Request) -> m (APIResponse a)
|
||||
send requestBuilder = do
|
||||
response <- sendPaginated Nothing requestBuilder
|
||||
|
|
|
@ -11,8 +11,8 @@ import Data.Maybe
|
|||
import qualified Database.SQLite.Simple as S
|
||||
|
||||
import SpaceTraders
|
||||
import SpaceTraders.Database.Utils
|
||||
import SpaceTraders.Model.System
|
||||
import SpaceTraders.Utils
|
||||
|
||||
addSystems :: (HasDatabaseConn env, MonadIO m, MonadReader env m) => [System] -> m ()
|
||||
addSystems systems = do
|
||||
|
@ -23,5 +23,5 @@ addSystems systems = do
|
|||
getSystems :: (HasDatabaseConn env, MonadIO m, MonadReader env m) => m [System]
|
||||
getSystems = do
|
||||
env <- ask
|
||||
ret <- liftIO $ S.query_ (getConn env) "SELECT data from systems;"
|
||||
ret <- liftIO $ S.query_ (getConn env) "SELECT data FROM systems;"
|
||||
return . catMaybes $ map (decodeText . head) ret
|
||||
|
|
|
@ -1,11 +0,0 @@
|
|||
module SpaceTraders.Database.Utils
|
||||
( decodeText
|
||||
) where
|
||||
|
||||
import Data.Aeson
|
||||
import Data.ByteString.Builder(toLazyByteString)
|
||||
import qualified Data.Text as T
|
||||
import Data.Text.Encoding (encodeUtf8Builder)
|
||||
|
||||
decodeText :: FromJSON a => T.Text -> Maybe a
|
||||
decodeText = decode . toLazyByteString . encodeUtf8Builder
|
22
haskell/src/SpaceTraders/Utils.hs
Normal file
22
haskell/src/SpaceTraders/Utils.hs
Normal file
|
@ -0,0 +1,22 @@
|
|||
module SpaceTraders.Utils
|
||||
( decodeText
|
||||
, fromJSONValue
|
||||
, int2ByteString
|
||||
) where
|
||||
|
||||
import Data.Aeson
|
||||
import Data.Aeson.Types
|
||||
import qualified Data.ByteString as B
|
||||
import qualified Data.ByteString.Builder as B
|
||||
import qualified Data.ByteString.Internal as B
|
||||
import qualified Data.Text as T
|
||||
import qualified Data.Text.Encoding as T
|
||||
|
||||
decodeText :: FromJSON a => T.Text -> Maybe a
|
||||
decodeText = decode . B.toLazyByteString . T.encodeUtf8Builder
|
||||
|
||||
fromJSONValue :: FromJSON a => Value -> Either String a
|
||||
fromJSONValue = parseEither parseJSON
|
||||
|
||||
int2ByteString :: Int -> B.ByteString
|
||||
int2ByteString = B.pack . map B.c2w . show
|
|
@ -18,7 +18,7 @@
|
|||
# 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/0.yaml
|
||||
url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/21/3.yaml
|
||||
|
||||
# User packages to be built.
|
||||
# Various formats can be used as shown in the example below.
|
||||
|
|
Loading…
Add table
Reference in a new issue