37 lines
1.6 KiB
Haskell
37 lines
1.6 KiB
Haskell
{-# LANGUAGE Safe #-}
|
|
{-# LANGUAGE StandaloneKindSignatures #-} -- because of -Weverything
|
|
{-# LANGUAGE StandaloneDeriving #-} -- to specify contexts
|
|
{-# LANGUAGE FlexibleContexts #-} -- 'non type-variable argument'
|
|
{-# LANGUAGE UndecidableInstances #-} -- instance head no smaller...
|
|
module Language.Scalie.Core.Module (Module(..)) where
|
|
|
|
import Data.Kind (Type)
|
|
import Language.Scalie.Core.Definition (Definition)
|
|
import Data.Map.Implicit (ImplicitMap)
|
|
|
|
-- | A module groups multiple related variable definitions.
|
|
--
|
|
-- >>> import Data.Functor.Identity (Identity(..))
|
|
-- >>> import Data.Map.Implicit qualified as ImplicitMap
|
|
-- >>> Module (Identity ImplicitMap.empty)
|
|
-- Module {definitions = Identity ImplicitMapElems []}
|
|
--
|
|
-- >>> import Data.Maybe (Maybe(..))
|
|
-- >>> Module Nothing
|
|
-- Module {definitions = Nothing}
|
|
--
|
|
-- >>> import Text.Read (readMaybe)
|
|
-- >>> readMaybe "Module { definitions = Just (ImplicitMapElems []) }" :: Maybe (Module Maybe)
|
|
-- Just (Module {definitions = Just ImplicitMapElems []})
|
|
--
|
|
-- >>> readMaybe "Module { definitions = Just (ImplicitMapElems [Definition { signature = Nothing, name = Just \"x\", body = Nothing } ]) }" :: Maybe (Module Maybe)
|
|
-- Just (Module {definitions = Just ImplicitMapElems [Definition {signature = Nothing, name = Just "x", body = Nothing}]})
|
|
|
|
type Module :: (Type -> Type) -> Type
|
|
type role Module nominal
|
|
newtype Module f = Module
|
|
{ definitions :: f (ImplicitMap (Definition f))
|
|
}
|
|
|
|
deriving stock instance (Show (f (ImplicitMap (Definition f)))) => Show (Module f)
|
|
deriving stock instance (Read (f (ImplicitMap (Definition f)))) => Read (Module f)
|