{-| This module provides the default resolver for pre-defined components.
-}
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

-- | Pre-defined resolver supports all components in this library.
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  -- ^ Name
  -> (a -> MiniLight c)  -- ^ Constructor of the component
  -> Resolver  -- ^ Old 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