Compare commits

..

3 commits

Author SHA1 Message Date
14104da125 feat: Read and show for Language.Scalie.Ast.Module 2025-08-12 14:51:40 +02:00
9336a88cb9 feat: prettied up ImplicitMap show and read 2025-08-12 14:51:25 +02:00
d38c30e318 fix: read ImplicitMap lawfully
Previously, the read instance could be used to break invariants.
2025-08-12 14:41:47 +02:00
2 changed files with 41 additions and 15 deletions

View file

@ -1,27 +1,41 @@
{-# LANGUAGE Safe #-} {-# LANGUAGE Safe #-}
{-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeFamilies #-} -- for KeyType
{-# LANGUAGE StandaloneDeriving #-} -- specify instance contexts
{-# LANGUAGE FlexibleContexts #-} -- use non type-variable argument in instance head {-# LANGUAGE FlexibleContexts #-} -- use non type-variable argument in instance head
{-# LANGUAGE UndecidableInstances #-} -- use type family in instance head {-# LANGUAGE UndecidableInstances #-} -- use type family in instance head
{-# LANGUAGE InstanceSigs #-}
-- | A Map that derives the keys for the mapping from the items. -- | A Map that derives the keys for the mapping from the items.
module Data.Map.Implicit (ImplicitMap(), get, ImplicitKeyOf(..), empty) where module Data.Map.Implicit (ImplicitMap(), get, ImplicitKeyOf(..), empty) where
import Data.Kind (Type, Constraint) import Data.Kind (Type, Constraint)
import Data.Map (Map) import Data.Map (Map)
import Text.Show (Show (show))
import Data.String (String)
import Control.Category ((.), Category (id))
import Data.Map qualified as Map import Data.Map qualified as Map
import Text.Show (Show) import Text.Read (Read (readPrec), ReadPrec)
import Text.Read (Read) import Data.List qualified as List
import Control.Arrow (Arrow ((&&&)))
import Data.Functor ((<$>))
import Data.Ord (Ord) import Data.Ord (Ord)
type ImplicitMap :: Type -> Type type ImplicitMap :: Type -> Type
type role ImplicitMap nominal type role ImplicitMap nominal
newtype ImplicitMap v = ImplicitMap { get :: Map (KeyType v) v } newtype ImplicitMap v = ImplicitMap { get :: Map (KeyType v) v }
deriving stock instance (Show (KeyType v), Show v) => Show (ImplicitMap v) type ImplicitMapElems :: Type -> Type
deriving stock instance (Read (KeyType v), Ord (KeyType v), Read v) => Read (ImplicitMap v) type role ImplicitMapElems representational
newtype ImplicitMapElems v = ImplicitMapElems [v]
deriving stock (Show, Read)
instance (Show v) => Show (ImplicitMap v) where
show :: ImplicitMap v -> String
show = show . ImplicitMapElems . Map.elems . get
instance (Read v, ImplicitKeyOf v, Ord (KeyType v)) => Read (ImplicitMap v) where
readPrec :: ReadPrec (ImplicitMap v)
readPrec = ImplicitMap . Map.fromList . List.map (keyOf &&& id) . (\(ImplicitMapElems es) -> es) <$> readPrec
type ImplicitKeyOf :: Type -> Constraint type ImplicitKeyOf :: Type -> Constraint
class ImplicitKeyOf v where class ImplicitKeyOf v where
type KeyType v :: Type type KeyType v :: Type
keyOf :: v -> KeyType v keyOf :: v -> KeyType v

View file

@ -10,18 +10,30 @@ import Language.Scalie.Ast.Definition (Definition)
import Data.Map.Implicit (ImplicitMap) import Data.Map.Implicit (ImplicitMap)
import Text.Show (Show) import Text.Show (Show)
import Text.Read (Read) import Text.Read (Read)
import Data.Text (Text)
import Language.Scalie.Ast.Expression (Expression)
import Language.Scalie.Domain.Type qualified as Scalie.Domain
import Data.Ord (Ord)
-- | A module groups multiple related definitions. -- | A module groups multiple related 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 Module :: (Type -> Type) -> Type
type role Module nominal type role Module nominal
data Module f = Module data Module f = Module
{ definitions :: ImplicitMap (Definition f) { definitions :: f (ImplicitMap (Definition f))
} }
deriving stock instance (Show (f Text), Show (f Expression), Show (f Scalie.Domain.Type)) => Show (Module f) deriving stock instance (Show (f (ImplicitMap (Definition f)))) => Show (Module f)
deriving stock instance (Read (f Text), Ord (f Text), Read (f Expression), Read (f Scalie.Domain.Type)) => Read (Module f) deriving stock instance (Read (f (ImplicitMap (Definition f)))) => Read (Module f)