-- |Global configuration for a Ribosome plugin.
module Ribosome.Data.PluginConfig where

import Ribosome.Data.PluginName (PluginName)
import Ribosome.Host.Data.HostConfig (HostConfig)
import Options.Applicative (Parser)
import GHC.Show (showParen)
import Text.Show (showsPrec)
import Exon (exon)

-- |The full configuration for a Ribosome plugin, consisting of the 'HostConfig', the plugin's name, and an arbitrary
-- type for additional config defined by individual plugins.
data PluginConfig c =
  PluginConfig {
    forall c. PluginConfig c -> PluginName
name :: PluginName,
    forall c. PluginConfig c -> HostConfig
host :: HostConfig,
    forall c. PluginConfig c -> Parser c
custom :: Parser c
  }
  deriving stock ((forall x. PluginConfig c -> Rep (PluginConfig c) x)
-> (forall x. Rep (PluginConfig c) x -> PluginConfig c)
-> Generic (PluginConfig c)
forall x. Rep (PluginConfig c) x -> PluginConfig c
forall x. PluginConfig c -> Rep (PluginConfig c) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall c x. Rep (PluginConfig c) x -> PluginConfig c
forall c x. PluginConfig c -> Rep (PluginConfig c) x
$cto :: forall c x. Rep (PluginConfig c) x -> PluginConfig c
$cfrom :: forall c x. PluginConfig c -> Rep (PluginConfig c) x
Generic)

instance Show (PluginConfig c) where
  showsPrec :: Int -> PluginConfig c -> ShowS
showsPrec Int
d PluginConfig {Parser c
HostConfig
PluginName
custom :: Parser c
host :: HostConfig
name :: PluginName
$sel:custom:PluginConfig :: forall c. PluginConfig c -> Parser c
$sel:host:PluginConfig :: forall c. PluginConfig c -> HostConfig
$sel:name:PluginConfig :: forall c. PluginConfig c -> PluginName
..} =
    Bool -> ShowS -> ShowS
showParen (Int
d Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
10) [exon|PluginConfing { name = #{showsPrec 11 name}, host = #{showsPrec 11 host} }|]

instance Eq (PluginConfig c) where
  PluginConfig PluginName
ln HostConfig
lh Parser c
_ == :: PluginConfig c -> PluginConfig c -> Bool
== PluginConfig PluginName
rn HostConfig
rh Parser c
_ =
    PluginName
ln PluginName -> PluginName -> Bool
forall a. Eq a => a -> a -> Bool
== PluginName
rn Bool -> Bool -> Bool
&& HostConfig
lh HostConfig -> HostConfig -> Bool
forall a. Eq a => a -> a -> Bool
== HostConfig
rh

-- |Construct a simple 'PluginConfig' with the default config for the host, given the plugin's name.
pluginNamed :: PluginName -> PluginConfig ()
pluginNamed :: PluginName -> PluginConfig ()
pluginNamed PluginName
name =
  PluginName -> HostConfig -> Parser () -> PluginConfig ()
forall c. PluginName -> HostConfig -> Parser c -> PluginConfig c
PluginConfig PluginName
name HostConfig
forall a. Default a => a
def Parser ()
forall (f :: * -> *). Applicative f => f ()
unit

instance IsString (PluginConfig ()) where
  fromString :: String -> PluginConfig ()
fromString =
    PluginName -> PluginConfig ()
pluginNamed (PluginName -> PluginConfig ())
-> (String -> PluginName) -> String -> PluginConfig ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> PluginName
forall a. IsString a => String -> a
fromString