-- | Definitions of montis core state.
module Montis.Core.State where

import Data.Data (Proxy (Proxy), Typeable)
import Data.Default.Class (Default, def)
import Data.Map qualified as M
import Data.Void (Void)
import Foreign (Ptr)
import Montis.Core.Events
import Montis.Core.Extensions
import Text.Read (readMaybe)

-- | An opaque type used for the world's self-reference.
newtype SelfPtr where
  SelfPtr :: Ptr Void -> SelfPtr

-- | This is the context the world operates under. The context contains data
-- which must be provided by the runtime or the configuration. This data may not
-- be cold-created.
--
-- Parameters:
--   `m` the monad for this Context. This is typically W.
data Context m where
  Context ::
    { ctxConfig :: Config m,
      ctxSelfPtr :: SelfPtr
    } ->
    Context m

-- | Montis configuration. This is the structure that defines the user-written
-- configuration, which is linked in.
data Config m where
  Config ::
    { startingHooks :: Hooks m,
      startupHook :: m (),
      resetHook :: m (),
      configExtensions :: M.Map ExtensionKey (Extension Nil)
    } ->
    Config m

-- | Hooks the runtime can call.
data Hooks m where
  Hooks ::
    { keyHook :: KeyEvent -> m (),
      surfaceHook :: SurfaceEvent -> m (),
      buttonHook :: ButtonEvent -> m (),
      motionHook :: MotionEvent -> m ()
    } ->
    Hooks m

-- | Class for a configurable model.
class (Typeable a) => ConfigModule m a where
  alterConfig :: a -> Config m -> Config m

-- | Configures a typed configuration extension.
install :: forall a m. (ConfigModule m a) => a -> Config m -> Config m
install a c =
  alterConfig a $
    c
      { configExtensions =
          M.insert
            (typeRepr (Proxy :: Proxy a))
            (Extension a)
            (configExtensions c)
      }

-- | Typeclass defining the set of types which can be used as state extensions
-- to the W monad. These state extensions may be persistent or not.
--
-- There are default implementations for all methods if the type implements
-- Read, Show and Default,
class (Typeable a) => StateExtension a where
  -- | The initial value used for the first time an extension is 'gotten' or
  -- demarshalling fails.
  initialValue :: a

  -- | Transforms a type into a string. If the type cannot be marshalled, this
  -- function should return Nothing.
  --
  -- If a type cannot be marshalled, it cannot persist across hot reloads.
  marshalExtension :: a -> Maybe String

  -- | Reads an extension from a string. If this type is not marshallable or
  -- reading fails, this function should return Nothing.
  demarshalExtension :: String -> Maybe a

  -- | If the type implements Default, use the default implementation.
  default initialValue :: (Default a) => a
  initialValue = def

  -- | If the type implements Show, use show for the marshalling.
  default marshalExtension :: (Show a) => a -> Maybe String
  marshalExtension = Just . show

  -- | If the type implements Read, use read for the demarshalling.
  default demarshalExtension :: (Read a) => String -> Maybe a
  demarshalExtension = readMaybe

-- | State type. This type contains changeable data.
data State m where
  State ::
    { -- The datastructure containing the state of the windows.

      -- | Current set of hooks. The initial hooks are provided by the
      -- configuration, but the hooks can change during operation. This is how
      -- key sequences can be mapped.
      currentHooks :: Hooks m,
      -- | Map from the typerep string to the state extension.
      extensibleState ::
        M.Map ExtensionKey (Either String (Extension StateExtension))
    } ->
    State m

-- | Lookup from an extension map by type.
lookupByType :: (Typeable a) => proxy a -> M.Map ExtensionKey b -> Maybe b
lookupByType pxy = M.lookup (typeRepr pxy)