{-# LANGUAGE DeriveGeneric #-}
module MiniLight.Loader.Internal.Types where

import Data.Aeson
import qualified Data.HashMap.Strict as HM
import qualified Data.Text as T
import qualified Data.Vector as V
import qualified Data.UUID
import qualified Data.UUID.V4
import GHC.Generics (Generic)
import MiniLight.Component
import MiniLight.Light

data Hook = Hook {
  Hook -> Text
signalName :: T.Text,
  Hook -> Value
parameter :: Value
} deriving (Int -> Hook -> ShowS
[Hook] -> ShowS
Hook -> String
(Int -> Hook -> ShowS)
-> (Hook -> String) -> ([Hook] -> ShowS) -> Show Hook
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Hook] -> ShowS
$cshowList :: [Hook] -> ShowS
show :: Hook -> String
$cshow :: Hook -> String
showsPrec :: Int -> Hook -> ShowS
$cshowsPrec :: Int -> Hook -> ShowS
Show, (forall x. Hook -> Rep Hook x)
-> (forall x. Rep Hook x -> Hook) -> Generic Hook
forall x. Rep Hook x -> Hook
forall x. Hook -> Rep Hook x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Hook x -> Hook
$cfrom :: forall x. Hook -> Rep Hook x
Generic)

instance ToJSON Hook

instance FromJSON Hook where
  parseJSON :: Value -> Parser Hook
parseJSON = String -> (Object -> Parser Hook) -> Value -> Parser Hook
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject "hook" ((Object -> Parser Hook) -> Value -> Parser Hook)
-> (Object -> Parser Hook) -> Value -> Parser Hook
forall a b. (a -> b) -> a -> b
$ \v :: Object
v ->
    Text -> Value -> Hook
Hook (Text -> Value -> Hook) -> Parser Text -> Parser (Value -> Hook)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: "name" Parser (Value -> Hook) -> Parser Value -> Parser Hook
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser Value
forall a. FromJSON a => Object -> Text -> Parser a
.: "parameter"

toHook :: Value -> Either T.Text Hook
toHook :: Value -> Either Text Hook
toHook =
  ( \case
      Success a :: Hook
a   -> Hook -> Either Text Hook
forall a b. b -> Either a b
Right Hook
a
      Error   err :: String
err -> Text -> Either Text Hook
forall a b. a -> Either a b
Left (Text -> Either Text Hook) -> Text -> Either Text Hook
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ ShowS
forall a. Show a => a -> String
show String
err
    )
    (Result Hook -> Either Text Hook)
-> (Value -> Result Hook) -> Value -> Either Text Hook
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> Result Hook
forall a. FromJSON a => Value -> Result a
fromJSON

-- | A configuration for a component
data ComponentConfig = ComponentConfig {
  ComponentConfig -> Text
componentType :: T.Text,
  ComponentConfig -> Maybe Text
tagID :: Maybe T.Text,
  ComponentConfig -> Value
properties :: Value,
  ComponentConfig -> Maybe (HashMap Text Hook)
hooks :: Maybe (HM.HashMap T.Text Hook)
}

instance ToJSON ComponentConfig where
  toJSON :: ComponentConfig -> Value
toJSON v :: ComponentConfig
v = HashMap String Value -> Value
forall a. ToJSON a => a -> Value
toJSON (HashMap String Value -> Value) -> HashMap String Value -> Value
forall a b. (a -> b) -> a -> b
$ [(String, Value)] -> HashMap String Value
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HM.fromList ([(String, Value)] -> HashMap String Value)
-> [(String, Value)] -> HashMap String Value
forall a b. (a -> b) -> a -> b
$ [("type" :: String, Text -> Value
String (ComponentConfig -> Text
componentType ComponentConfig
v)), ("properties", ComponentConfig -> Value
properties ComponentConfig
v)] [(String, Value)] -> [(String, Value)] -> [(String, Value)]
forall a. [a] -> [a] -> [a]
++ [(String, Value)]
-> (Text -> [(String, Value)]) -> Maybe Text -> [(String, Value)]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (\x :: Text
x -> [("id", Text -> Value
String Text
x)]) (ComponentConfig -> Maybe Text
tagID ComponentConfig
v)

instance FromJSON ComponentConfig where
  parseJSON :: Value -> Parser ComponentConfig
parseJSON = String
-> (Object -> Parser ComponentConfig)
-> Value
-> Parser ComponentConfig
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject "component" ((Object -> Parser ComponentConfig)
 -> Value -> Parser ComponentConfig)
-> (Object -> Parser ComponentConfig)
-> Value
-> Parser ComponentConfig
forall a b. (a -> b) -> a -> b
$ \v :: Object
v -> do
    Text
componentType <- Object
v Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: "type"
    Maybe Text
tagID <- Object
v Object -> Text -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? "id"
    Value
props <- Object
v Object -> Text -> Parser Value
forall a. FromJSON a => Object -> Text -> Parser a
.: "properties"

    ComponentConfig -> Parser ComponentConfig
forall (m :: * -> *) a. Monad m => a -> m a
return (ComponentConfig -> Parser ComponentConfig)
-> ComponentConfig -> Parser ComponentConfig
forall a b. (a -> b) -> a -> b
$ Text
-> Maybe Text
-> Value
-> Maybe (HashMap Text Hook)
-> ComponentConfig
ComponentConfig Text
componentType Maybe Text
tagID Value
props Maybe (HashMap Text Hook)
forall a. Maybe a
Nothing

-- | A configuration for the application itself
data AppConfig = AppConfig {
  AppConfig -> Vector ComponentConfig
app :: V.Vector ComponentConfig,
  AppConfig -> Vector Text
uuid :: V.Vector T.Text
}

instance FromJSON AppConfig where
  parseJSON :: Value -> Parser AppConfig
parseJSON = String -> (Object -> Parser AppConfig) -> Value -> Parser AppConfig
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject "app" ((Object -> Parser AppConfig) -> Value -> Parser AppConfig)
-> (Object -> Parser AppConfig) -> Value -> Parser AppConfig
forall a b. (a -> b) -> a -> b
$ \v :: Object
v -> do
    Vector ComponentConfig
app <- Object
v Object -> Text -> Parser (Vector ComponentConfig)
forall a. FromJSON a => Object -> Text -> Parser a
.: "app"

    AppConfig -> Parser AppConfig
forall (m :: * -> *) a. Monad m => a -> m a
return (AppConfig -> Parser AppConfig) -> AppConfig -> Parser AppConfig
forall a b. (a -> b) -> a -> b
$ Vector ComponentConfig -> Vector Text -> AppConfig
AppConfig Vector ComponentConfig
app Vector Text
forall a. Vector a
V.empty

-- | The type for component resolver
type Resolver
  = T.Text  -- ^ Component Type
  -> T.Text  -- ^ UID
  -> Value  -- ^ Component Property
  -> MiniLight (Either String Component)

-- | Generate an unique id.
newUID :: MonadIO m => m T.Text
newUID :: m Text
newUID = IO Text -> m Text
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Text -> m Text) -> IO Text -> m Text
forall a b. (a -> b) -> a -> b
$ UUID -> Text
Data.UUID.toText (UUID -> Text) -> IO UUID -> IO Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO UUID
Data.UUID.V4.nextRandom