module Data.Component.Resolver (
resolver,
extendResolver,
) where
import Control.Monad
import Data.Aeson
import qualified Data.Text as T
import MiniLight
import qualified Data.Component.AnimationLayer as AnimationLayer
import qualified Data.Component.Button as Button
import qualified Data.Component.Layer as Layer
import qualified Data.Component.MessageEngine as MessageEngine
import qualified Data.Component.MessageLayer as MessageLayer
import qualified Data.Component.Selection as Selection
foldResult :: (String -> b) -> (a -> b) -> Result a -> b
foldResult :: (String -> b) -> (a -> b) -> Result a -> b
foldResult f :: String -> b
f g :: a -> b
g r :: Result a
r = case Result a
r of
Error err :: String
err -> String -> b
f String
err
Success a :: a
a -> a -> b
g a
a
resultM
:: Result a
-> (a -> MiniLight Component)
-> MiniLight (Either String Component)
resultM :: Result a
-> (a -> MiniLight Component)
-> MiniLight (Either String Component)
resultM r :: Result a
r m :: a -> MiniLight Component
m = (String -> MiniLight (Either String Component))
-> (a -> MiniLight (Either String Component))
-> Result a
-> MiniLight (Either String Component)
forall b a. (String -> b) -> (a -> b) -> Result a -> b
foldResult (Either String Component -> MiniLight (Either String Component)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either String Component -> MiniLight (Either String Component))
-> (String -> Either String Component)
-> String
-> MiniLight (Either String Component)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Either String Component
forall a b. a -> Either a b
Left) ((Component -> Either String Component)
-> MiniLight Component -> MiniLight (Either String Component)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Component -> Either String Component
forall a b. b -> Either a b
Right (MiniLight Component -> MiniLight (Either String Component))
-> (a -> MiniLight Component)
-> a
-> MiniLight (Either String Component)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> MiniLight Component
m) Result a
r
resolver :: Resolver
resolver :: Resolver
resolver name :: Text
name uid :: Text
uid props :: Value
props = case Text
name of
"animation-layer" ->
Result Config
-> (Config -> MiniLight Component)
-> MiniLight (Either String Component)
forall a.
Result a
-> (a -> MiniLight Component)
-> MiniLight (Either String Component)
resultM (Value -> Result Config
forall a. FromJSON a => Value -> Result a
fromJSON Value
props) ((Config -> MiniLight Component)
-> MiniLight (Either String Component))
-> (Config -> MiniLight Component)
-> MiniLight (Either String Component)
forall a b. (a -> b) -> a -> b
$ Text -> AnimationLayer -> MiniLight Component
forall c env (m :: * -> *).
(ComponentUnit c, HasLightEnv env, MonadIO m, MonadMask m) =>
Text -> c -> LightT env m Component
newComponent Text
uid (AnimationLayer -> MiniLight Component)
-> (Config -> LightT LightEnv IO AnimationLayer)
-> Config
-> MiniLight Component
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< Config -> LightT LightEnv IO AnimationLayer
AnimationLayer.new
"button" -> Result Config
-> (Config -> MiniLight Component)
-> MiniLight (Either String Component)
forall a.
Result a
-> (a -> MiniLight Component)
-> MiniLight (Either String Component)
resultM (Value -> Result Config
forall a. FromJSON a => Value -> Result a
fromJSON Value
props) ((Config -> MiniLight Component)
-> MiniLight (Either String Component))
-> (Config -> MiniLight Component)
-> MiniLight (Either String Component)
forall a b. (a -> b) -> a -> b
$ Text -> Button -> MiniLight Component
forall c env (m :: * -> *).
(ComponentUnit c, HasLightEnv env, MonadIO m, MonadMask m) =>
Text -> c -> LightT env m Component
newComponent Text
uid (Button -> MiniLight Component)
-> (Config -> LightT LightEnv IO Button)
-> Config
-> MiniLight Component
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< Config -> LightT LightEnv IO Button
Button.new
"layer" -> Result Config
-> (Config -> MiniLight Component)
-> MiniLight (Either String Component)
forall a.
Result a
-> (a -> MiniLight Component)
-> MiniLight (Either String Component)
resultM (Value -> Result Config
forall a. FromJSON a => Value -> Result a
fromJSON Value
props) ((Config -> MiniLight Component)
-> MiniLight (Either String Component))
-> (Config -> MiniLight Component)
-> MiniLight (Either String Component)
forall a b. (a -> b) -> a -> b
$ Text -> Layer -> MiniLight Component
forall c env (m :: * -> *).
(ComponentUnit c, HasLightEnv env, MonadIO m, MonadMask m) =>
Text -> c -> LightT env m Component
newComponent Text
uid (Layer -> MiniLight Component)
-> (Config -> LightT LightEnv IO Layer)
-> Config
-> MiniLight Component
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< Config -> LightT LightEnv IO Layer
Layer.new
"message-engine" ->
Result Config
-> (Config -> MiniLight Component)
-> MiniLight (Either String Component)
forall a.
Result a
-> (a -> MiniLight Component)
-> MiniLight (Either String Component)
resultM (Value -> Result Config
forall a. FromJSON a => Value -> Result a
fromJSON Value
props) ((Config -> MiniLight Component)
-> MiniLight (Either String Component))
-> (Config -> MiniLight Component)
-> MiniLight (Either String Component)
forall a b. (a -> b) -> a -> b
$ Text -> MessageEngine -> MiniLight Component
forall c env (m :: * -> *).
(ComponentUnit c, HasLightEnv env, MonadIO m, MonadMask m) =>
Text -> c -> LightT env m Component
newComponent Text
uid (MessageEngine -> MiniLight Component)
-> (Config -> LightT LightEnv IO MessageEngine)
-> Config
-> MiniLight Component
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< Config -> LightT LightEnv IO MessageEngine
MessageEngine.new
"message-layer" ->
Result Config
-> (Config -> MiniLight Component)
-> MiniLight (Either String Component)
forall a.
Result a
-> (a -> MiniLight Component)
-> MiniLight (Either String Component)
resultM (Value -> Result Config
forall a. FromJSON a => Value -> Result a
fromJSON Value
props) ((Config -> MiniLight Component)
-> MiniLight (Either String Component))
-> (Config -> MiniLight Component)
-> MiniLight (Either String Component)
forall a b. (a -> b) -> a -> b
$ Text -> MessageLayer -> MiniLight Component
forall c env (m :: * -> *).
(ComponentUnit c, HasLightEnv env, MonadIO m, MonadMask m) =>
Text -> c -> LightT env m Component
newComponent Text
uid (MessageLayer -> MiniLight Component)
-> (Config -> LightT LightEnv IO MessageLayer)
-> Config
-> MiniLight Component
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< Config -> LightT LightEnv IO MessageLayer
MessageLayer.new
"tiled-layer" ->
Result Config
-> (Config -> MiniLight Component)
-> MiniLight (Either String Component)
forall a.
Result a
-> (a -> MiniLight Component)
-> MiniLight (Either String Component)
resultM (Value -> Result Config
forall a. FromJSON a => Value -> Result a
fromJSON Value
props) ((Config -> MiniLight Component)
-> MiniLight (Either String Component))
-> (Config -> MiniLight Component)
-> MiniLight (Either String Component)
forall a b. (a -> b) -> a -> b
$ Text -> Layer -> MiniLight Component
forall c env (m :: * -> *).
(ComponentUnit c, HasLightEnv env, MonadIO m, MonadMask m) =>
Text -> c -> LightT env m Component
newComponent Text
uid (Layer -> MiniLight Component)
-> (Config -> LightT LightEnv IO Layer)
-> Config
-> MiniLight Component
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< Config -> LightT LightEnv IO Layer
Layer.newNineTile
"selection" -> Result Config
-> (Config -> MiniLight Component)
-> MiniLight (Either String Component)
forall a.
Result a
-> (a -> MiniLight Component)
-> MiniLight (Either String Component)
resultM (Value -> Result Config
forall a. FromJSON a => Value -> Result a
fromJSON Value
props) ((Config -> MiniLight Component)
-> MiniLight (Either String Component))
-> (Config -> MiniLight Component)
-> MiniLight (Either String Component)
forall a b. (a -> b) -> a -> b
$ Text -> Selection -> MiniLight Component
forall c env (m :: * -> *).
(ComponentUnit c, HasLightEnv env, MonadIO m, MonadMask m) =>
Text -> c -> LightT env m Component
newComponent Text
uid (Selection -> MiniLight Component)
-> (Config -> LightT LightEnv IO Selection)
-> Config
-> MiniLight Component
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< Config -> LightT LightEnv IO Selection
Selection.new
_ -> Either String Component -> MiniLight (Either String Component)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either String Component -> MiniLight (Either String Component))
-> Either String Component -> MiniLight (Either String Component)
forall a b. (a -> b) -> a -> b
$ String -> Either String Component
forall a b. a -> Either a b
Left (String -> Either String Component)
-> String -> Either String Component
forall a b. (a -> b) -> a -> b
$ "Unsupported component: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Text -> String
T.unpack Text
name
extendResolver
:: (FromJSON a, ComponentUnit c)
=> T.Text
-> (a -> MiniLight c)
-> Resolver
-> Resolver
extendResolver :: Text -> (a -> MiniLight c) -> Resolver -> Resolver
extendResolver newName :: Text
newName func :: a -> MiniLight c
func resolver :: Resolver
resolver name :: Text
name uid :: Text
uid props :: Value
props = if Text
name Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
newName
then Result a
-> (a -> MiniLight Component)
-> MiniLight (Either String Component)
forall a.
Result a
-> (a -> MiniLight Component)
-> MiniLight (Either String Component)
resultM (Value -> Result a
forall a. FromJSON a => Value -> Result a
fromJSON Value
props) ((a -> MiniLight Component) -> MiniLight (Either String Component))
-> (a -> MiniLight Component)
-> MiniLight (Either String Component)
forall a b. (a -> b) -> a -> b
$ Text -> c -> MiniLight Component
forall c env (m :: * -> *).
(ComponentUnit c, HasLightEnv env, MonadIO m, MonadMask m) =>
Text -> c -> LightT env m Component
newComponent Text
uid (c -> MiniLight Component)
-> (a -> MiniLight c) -> a -> MiniLight Component
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< a -> MiniLight c
func
else Resolver
resolver Text
name Text
uid Value
props