1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
|
-- | 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)
|
