graninas/Hydra
1
1
Fork 0
mirror of https://github.com/graninas/Hydra.git synced 2024-11-24 04:31:29 +03:00
Code Issues Projects Releases Wiki Activity

LTS version bumped to 18.28. Build fixed

Browse Source
This commit is contained in:
Alexander Granin 2022-09-22 00:24:27 +04:00
parent ea3e70ee35
commit 7ce16e705c
11 changed files with 40 additions and 37 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
app/astro/src/Astro/API.hs
View File

@ -19,8 +19,8 @@ import Astro.Domain.AstroObject
type AstroAPI =
( "meteors"
:> QueryParam "mass" Int
:> QueryParam "size" Int
:> QueryParam "mass" Int32
:> QueryParam "size" Int32
:> Get '[JSON] Meteors
)
:<|>

8
app/astro/src/Astro/API/Meteor.hs
View File

@ -6,9 +6,9 @@ module Astro.API.Meteor where
import Hydra.Prelude
data MeteorTemplate = MeteorTemplate
{ size :: Int
, mass :: Int
, azimuth :: Int
, altitude :: Int
{ size :: Int32
, mass :: Int32
, azimuth :: Int32
, altitude :: Int32
}
deriving (Show, Eq, Ord, Generic, ToJSON, FromJSON)

6
app/astro/src/Astro/Catalogue.hs
View File

@ -30,7 +30,7 @@ loadMeteor astroDB = L.withKVDB astroDB
$ L.loadEntity
$ KVDB.mkMeteorKey 0
loadMeteorsCount :: AppState -> L.LangL Int
loadMeteorsCount :: AppState -> L.LangL Int32
loadMeteorsCount st = do
eCount <- withAstroKVDB st $ L.loadEntity KVDB.meteorsCountKey
case eCount of
@ -78,13 +78,13 @@ connectOrFail :: D.DBConfig BS.SqliteM -> L.AppL (D.SqlConn BS.SqliteM)
connectOrFail cfg = doOrFail' ConnectionFailedException $ L.getOrInitSqlConn cfg
getMeteors :: Maybe Int -> Maybe Int -> D.SqlConn BS.SqliteM -> L.AppL Meteors
getMeteors :: Maybe Int32 -> Maybe Int32 -> D.SqlConn BS.SqliteM -> L.AppL Meteors
getMeteors mbMass mbSize conn = do
L.logInfo $ "Lookup meteors with mbMass and mbSize: " <> show (mbMass, mbSize)
let predicate meteorDB = case (mbMass, mbSize) of
(Just m, Just s) -> (SqlDB._meteorSize meteorDB ==. B.val_ s)
&&. (SqlDB._meteorMass meteorDB ==. B.val_ m)
&&. (SqlDB._meteorMass meteorDB ==. B.val_ m)
(Just m, Nothing) -> (SqlDB._meteorMass meteorDB ==. B.val_ m)
(Nothing, Just s) -> (SqlDB._meteorSize meteorDB ==. B.val_ s)
_ -> B.val_ True

11
app/astro/src/Astro/Client/Common.hs
View File

@ -9,7 +9,6 @@ import Hydra.Prelude
import qualified Data.ByteString.Lazy as BSL
import qualified Data.ByteString.Lazy.Char8 as BSL8
import Data.Aeson (decode)
import Data.Either (rights)
import Servant
import Servant.Client (ClientM, BaseUrl(..), Scheme(..), client)
@ -39,12 +38,12 @@ data DIApproach
| GADT -- ^ GADT
deriving (Show, Read, Bounded, Eq, Ord, Enum)
setPhysical :: Int -> Physical -> ClientM Int
setOrbital :: Int -> Orbital -> ClientM Int
setObjectTemplate :: API.AstroObjectTemplate -> ClientM Int
getObject :: Int -> ClientM (Maybe AstroObject)
setPhysical :: Int32 -> Physical -> ClientM Int32
setOrbital :: Int32 -> Orbital -> ClientM Int32
setObjectTemplate :: API.AstroObjectTemplate -> ClientM Int32
getObject :: Int32 -> ClientM (Maybe AstroObject)
meteors :: Maybe Int -> Maybe Int -> ClientM Meteors
meteors :: Maybe Int32 -> Maybe Int32 -> ClientM Meteors
meteor :: API.MeteorTemplate -> ClientM MeteorId
asteroid :: API.AsteroidTemplate -> ClientM AsteroidId
( meteors

2
app/astro/src/Astro/Domain/Asteroid.hs
View File

@ -7,7 +7,7 @@ import Hydra.Prelude
import Astro.Domain.Types
type AsteroidId = Int
type AsteroidId = Int32
data Asteroid = Asteroid
{ asteroidId :: AsteroidId

2
app/astro/src/Astro/Domain/AstroObject.hs
View File

@ -7,7 +7,7 @@ import Hydra.Prelude
import Astro.Domain.Types
type AstroObjectId = Int
type AstroObjectId = Int32
data AstroObject = AstroObject

10
app/astro/src/Astro/Domain/Meteor.hs
View File

@ -10,17 +10,17 @@ import Data.Time.Clock (UTCTime)
type DateTime = UTCTime
data Coords = Coords
{ azimuth :: Int
, altitude :: Int
{ azimuth :: Int32
, altitude :: Int32
}
deriving (Show, Eq, Ord, Generic, ToJSON, FromJSON)
type MeteorId = Int
type MeteorId = Int32
data Meteor = Meteor
{ meteorId :: MeteorId
, size :: Int
, mass :: Int
, size :: Int32
, mass :: Int32
, coords :: Coords
, timestamp :: DateTime
}

14
app/astro/src/Astro/KVDB/AstroDB.hs
View File

@ -31,10 +31,10 @@ instance D.DBEntity AstroDB MeteorEntity where
data KeyEntity MeteorEntity = MeteorKey D.MeteorId
deriving (Show, Eq, Ord)
data ValueEntity MeteorEntity = KVDBMeteor
{ size :: Int
, mass :: Int
, azmt :: Int
, alt :: Int
{ size :: Int32
, mass :: Int32
, azmt :: Int32
, alt :: Int32
, time :: D.DateTime
}
deriving (Show, Eq, Ord, Generic, ToJSON, FromJSON)
@ -77,7 +77,7 @@ data MeteorsCountEntity
instance D.DBEntity AstroDB MeteorsCountEntity where
data KeyEntity MeteorsCountEntity = MeteorsCountKey String
deriving (Show, Eq, Ord)
data ValueEntity MeteorsCountEntity = MeteorsCountValue Int
data ValueEntity MeteorsCountEntity = MeteorsCountValue Int32
deriving (Show, Eq, Ord, Generic, ToJSON, FromJSON)
toDBKey (MeteorsCountKey k) = show k
toDBValue = D.toDBValueJSON
@ -86,7 +86,7 @@ instance D.DBEntity AstroDB MeteorsCountEntity where
instance D.AsKeyEntity MeteorsCountEntity String where
toKeyEntity _ = MeteorsCountKey "meteors_count"
instance D.AsValueEntity MeteorsCountEntity Int where
instance D.AsValueEntity MeteorsCountEntity Int32 where
toValueEntity = MeteorsCountValue
fromValueEntity _ (MeteorsCountValue v) = v
@ -96,5 +96,5 @@ meteorsCountKey = D.toKeyEntity ("" :: String)
-- ------------------------------------------------------------------
toIdxBase :: Int -> String
toIdxBase :: Int32 -> String
toIdxBase = printf "%07d"

2
app/astro/src/Astro/Server.hs
View File

@ -109,7 +109,7 @@ submitObjectPhysical = error "not implemented"
submitObjectOrbital :: AstroObjectId -> Orbital -> AppHandler AstroObjectId
submitObjectOrbital = error "not implemented"
meteors :: Maybe Int -> Maybe Int -> AppHandler Meteors
meteors :: Maybe Int32 -> Maybe Int32 -> AppHandler Meteors
meteors mbMass mbSize = runApp
$ withDB dbConfig
$ getMeteors mbMass mbSize

12
app/astro/src/Astro/SqlDB/AstroDB.hs
View File

@ -12,17 +12,17 @@ import qualified Database.Beam as B
import qualified Astro.Domain.Meteor as D
data MeteorT f = Meteor
{ _meteorId :: B.C f Int
, _meteorSize :: B.C f Int
, _meteorMass :: B.C f Int
, _meteorAzimuth :: B.C f Int
, _meteorAltitude :: B.C f Int
{ _meteorId :: B.C f Int32
, _meteorSize :: B.C f Int32
, _meteorMass :: B.C f Int32
, _meteorAzimuth :: B.C f Int32
, _meteorAltitude :: B.C f Int32
, _meteorTimestamp :: B.C f UTCTime
} deriving (Generic, B.Beamable)
instance B.Table MeteorT where
data PrimaryKey MeteorT f =
MeteorId (B.C f Int) deriving (Generic, B.Beamable)
MeteorId (B.C f Int32) deriving (Generic, B.Beamable)
primaryKey = MeteorId . _meteorId
type Meteor = MeteorT Identity

6
stack.yaml
View File

@ -1,4 +1,4 @@
resolver: lts-14.4
resolver: lts-18.28
packages:
- lib/hydra-base
@ -15,3 +15,7 @@ extra-deps:
- base58-bytestring-0.1.0
- time-units-1.0.0
- rocksdb-haskell-1.0.1
- beam-core-0.9.2.1@sha256:33b9a2bf40f4b3408a2c7b58d001d7cf133aa1e2c95b5c5d782838c6b989cf24,5282
- beam-migrate-0.5.1.2@sha256:e385a2ddb213398aca38a4f15334613057552b83a467a81c0dc3562c49a59884,4923
- beam-postgres-0.5.2.1@sha256:5ba4fecca3a210790aa858e32469d126995c25f08dc89df267cf987301c2269f,4392
- beam-sqlite-0.5.1.2@sha256:7486e165b8ae625a9a7e27df1be4df9f92d03841342362e58459d09343c04f7d,3671