Client app WIP

app/astro/Astro/API.hs

@@ -0,0 +1,7 @@
+module Astro.API
+  ( module X
+  ) where
+
+
+import Astro.API.Asteroid as X
+import Astro.API.Meteor as X

app/astro/Astro/API/Asteroid.hs

@@ -13,6 +13,3 @@ data AsteroidTemplate = AsteroidTemplate
   , physical    :: Physical
   }
   deriving (Show, Eq, Ord, Generic, ToJSON, FromJSON)
-
-
-type Asteroids = [Asteroid]

app/astro/Astro/Client.hs

@@ -10,62 +10,62 @@ module Astro.Client
 import           Hydra.Prelude
 import qualified Data.ByteString.Lazy as BSL
 import           Data.Aeson (decode)
+import           Data.Either (rights)
 
 import qualified Hydra.Domain  as D
 import qualified Hydra.Runtime as R
 import qualified Hydra.Interpreters as R
 import qualified Hydra.Language     as L
 
+import           Astro.Common (loggerCfg)
 import           Astro.Domain.Meteor
 import           Astro.Domain.Asteroid
-import           Astro.API.Meteor
-import           Astro.API.Asteroid
 import           Astro.Types
+import qualified Astro.API as API
 
 
-reportAsteroid :: API.AsteroidTemplate -> Flow ()
+reportAsteroid :: API.AsteroidTemplate -> L.AppL ()
 reportAsteroid asteroid = undefined
 
-reportMeteor :: API.MeteorTemplate -> Flow ()
+reportMeteor :: API.MeteorTemplate -> L.AppL ()
 reportMeteor meteor = undefined
 
-tryParseCmd :: BSL.BytetString -> Either BSL.BytetString obj
+tryParseCmd
+  :: FromJSON obj
+  => BSL.ByteString
+  -> Either BSL.ByteString obj
 tryParseCmd str = case decode str of
   Nothing -> Left "Decoding failed."
   Just obj -> Right obj
 
+asteroidReporter = undefined
+meteorReporter = undefined
 
-
+reportObject
-reportObject :: (obj -> Flow ()) -> obj -> Flow (Either BS.ByteString ())
+  :: FromJSON obj
+  => (obj -> L.AppL ())
+  -> (Either BSL.ByteString obj)
+  -> L.AppL (Either BSL.ByteString ())
 reportObject reporter obj = undefined
 
-consoleFlow :: Flow ()
+consoleApp :: L.AppL ()
-consoleFlow = do
+consoleApp = do
-  line <- L.runIO $ BSL.putStr "> " >> BSL.getLine
+  line <- L.evalIO $ BSL.putStr "> " >> BSL.getContents
 
   let runners =
-        [ reportObject asteroidReporter $ tryParseCmd @AsteroidTemplate line
+        [ reportObject asteroidReporter $ tryParseCmd @(API.AsteroidTemplate) line
-        , reportObject meteorReporter   $ tryParseCmd @MeteorTemplate   line
+        , reportObject meteorReporter   $ tryParseCmd @(API.MeteorTemplate)   line
         ]
 
   eResult <- sequence runners
-  case eResult of
+  case rights eResult of
-    Left err -> L.runIO $ BSL.putStrLn $ "Command failed: " <> err
+    [] -> L.evalIO $ BSL.putStrLn "Command is not recognized."
-    Right _ -> pure ()
+    [()] -> pure ()
+    (_) -> L.evalIO $ BSL.putStrLn "Multiple commands evaluated unexpectedly"
 
-  consoleFlow
+  consoleApp
-
-  case parseCmd line of
-    Nothing -> do
-      L.runIO $ BSL.putStrLn "Command not recognized."
-      consoleFlow
-    Just asteroid@(API.AsteroidTemplate {}) -> reportAsteroid asteroid
-    Just meteor@(API.MeteorTemplate {})     -> reportMeteor meteor
 
 
 runAstroClient :: IO ()
-runAstroClient = do
+runAstroClient = R.withAppRuntime (Just loggerCfg)
-
+    $ \rt -> R.runAppL rt consoleApp
-    R.withAppRuntime (Just loggerCfg) $ \rt -> do
-      appSt <- R.runAppL rt $ initState AppConfig
-      run 8080 $ astroBackendApp $ Env rt appSt

app/astro/Astro/Common.hs

@@ -7,6 +7,7 @@ module Astro.Common where
 
 import           Hydra.Prelude
 import qualified Hydra.Domain  as D
+import qualified Database.Beam.Sqlite as BS
 
 -- TODO: configs from the command line
 dbConfig :: D.DBConfig BS.SqliteM

app/astro/Astro/Domain/Types.hs

@@ -20,23 +20,29 @@ data Coords = Coords
 type AstronomicalUnit = Double
 
 data Orbital = Orbital
-  { epoch                 :: UTCTime
+  { apoapsis              :: AstronomicalUnit
-  , apoapsis              :: AstronomicalUnit
   , periapsis             :: AstronomicalUnit
-  , semiMajorAxis         :: AstronomicalUnit
+
-  , Eccentrity            :: Double
+  -- Enough fields for demo.
-  , Inclination           :: Double
+
-  , Longitude             :: Double
+  -- , epoch                 :: UTCTime
-  , ArgumentOfPeriapsis   :: Double
+  -- , semiMajorAxis         :: AstronomicalUnit
-  , OrbitalPeriod         :: Double
+  -- , eccentrity            :: Double
-  , AvgOrbitalSpeed       :: Double
+  -- , inclination           :: Double
+  -- , longitude             :: Double
+  -- , argumentOfPeriapsis   :: Double
+  -- , orbitalPeriod         :: Double
+  -- , avgOrbitalSpeed       :: Double
   }
   deriving (Show, Eq, Ord, Generic, ToJSON, FromJSON)
 
 data Physical = Physical
   { meanDiameter    :: Double
   , rotationPeriod  :: Double
-  , albedo          :: Double
+
+
+  -- Enough fields for demo.
+  -- , albedo          :: Double
   }
   deriving (Show, Eq, Ord, Generic, ToJSON, FromJSON)
 

app/astro/Astro/Server.hs

@@ -26,6 +26,7 @@ import qualified Hydra.Runtime as R
 import qualified Hydra.Interpreters as R
 import qualified Hydra.Language     as L
 
+import           Astro.Common (loggerCfg, dbConfig)
 import           Astro.API.Meteor
 import           Astro.Domain.Meteor
 import           Astro.Catalogue
@@ -79,10 +80,6 @@ astroServer'
      = meteors
   :<|> meteor
 
--- TODO: configs from the command line
-dbConfig :: D.DBConfig BS.SqliteM
-dbConfig = D.mkSQLiteConfig "/tmp/astro.db"
-
 meteors :: Maybe Int -> Maybe Int -> AppHandler Meteors
 meteors mbMass mbSize = runApp
   $ withDB dbConfig
@@ -93,15 +90,6 @@ meteor m = runApp
   $ withDB dbConfig
   $ createMeteor m
 
-loggerCfg :: D.LoggerConfig
-loggerCfg = D.LoggerConfig
-  { D._format       = "$prio $loggername: $msg"
-  , D._level        = D.Debug
-  , D._logFilePath  = ""
-  , D._logToConsole = True
-  , D._logToFile    = False
-  }
-
 prepareSQLiteDB :: IO ()
 prepareSQLiteDB = do
   putStrLn @String "Copying astro_template.db to /tmp/astro.db..."