From d38c30e318975129ed5173185365de25654ac3ec Mon Sep 17 00:00:00 2001 From: VegOwOtenks Date: Tue, 12 Aug 2025 14:41:47 +0200 Subject: [PATCH 1/3] fix: read ImplicitMap lawfully Previously, the read instance could be used to break invariants. --- src/Data/Map/Implicit.hs | 28 +++++++++++++++++++++------- 1 file changed, 21 insertions(+), 7 deletions(-) diff --git a/src/Data/Map/Implicit.hs b/src/Data/Map/Implicit.hs index ab2906e..83d5c4a 100644 --- a/src/Data/Map/Implicit.hs +++ b/src/Data/Map/Implicit.hs @@ -1,27 +1,41 @@ {-# LANGUAGE Safe #-} -{-# LANGUAGE TypeFamilies #-} -{-# LANGUAGE StandaloneDeriving #-} -- specify instance contexts +{-# LANGUAGE TypeFamilies #-} -- for KeyType {-# LANGUAGE FlexibleContexts #-} -- use non type-variable argument 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. module Data.Map.Implicit (ImplicitMap(), get, ImplicitKeyOf(..), empty) where import Data.Kind (Type, Constraint) 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 Text.Show (Show) -import Text.Read (Read) +import Text.Read (Read (readPrec), ReadPrec) +import Data.List qualified as List +import Control.Arrow (Arrow ((&&&))) +import Data.Functor ((<$>)) import Data.Ord (Ord) type ImplicitMap :: Type -> Type type role ImplicitMap nominal newtype ImplicitMap v = ImplicitMap { get :: Map (KeyType v) v } -deriving stock instance (Show (KeyType v), Show v) => Show (ImplicitMap v) -deriving stock instance (Read (KeyType v), Ord (KeyType v), Read v) => Read (ImplicitMap v) +type ImplicitMapElems :: Type -> Type +type role ImplicitMapElems representational +newtype ImplicitMapElems v = ImplicitMapElems { elems :: [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) . elems <$> readPrec type ImplicitKeyOf :: Type -> Constraint - class ImplicitKeyOf v where type KeyType v :: Type keyOf :: v -> KeyType v From 9336a88cb9702c9e272ad6f7b9274635967f3682 Mon Sep 17 00:00:00 2001 From: VegOwOtenks Date: Tue, 12 Aug 2025 14:51:25 +0200 Subject: [PATCH 2/3] feat: prettied up ImplicitMap show and read --- src/Data/Map/Implicit.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/Data/Map/Implicit.hs b/src/Data/Map/Implicit.hs index 83d5c4a..ac0d459 100644 --- a/src/Data/Map/Implicit.hs +++ b/src/Data/Map/Implicit.hs @@ -24,7 +24,7 @@ newtype ImplicitMap v = ImplicitMap { get :: Map (KeyType v) v } type ImplicitMapElems :: Type -> Type type role ImplicitMapElems representational -newtype ImplicitMapElems v = ImplicitMapElems { elems :: [v] } +newtype ImplicitMapElems v = ImplicitMapElems [v] deriving stock (Show, Read) instance (Show v) => Show (ImplicitMap v) where @@ -33,7 +33,7 @@ instance (Show v) => Show (ImplicitMap v) where instance (Read v, ImplicitKeyOf v, Ord (KeyType v)) => Read (ImplicitMap v) where readPrec :: ReadPrec (ImplicitMap v) - readPrec = ImplicitMap . Map.fromList . List.map (keyOf &&& id) . elems <$> readPrec + readPrec = ImplicitMap . Map.fromList . List.map (keyOf &&& id) . (\(ImplicitMapElems es) -> es) <$> readPrec type ImplicitKeyOf :: Type -> Constraint class ImplicitKeyOf v where From 14104da1250f81daac31b6fffc0d1a37a90dc140 Mon Sep 17 00:00:00 2001 From: VegOwOtenks Date: Tue, 12 Aug 2025 14:51:40 +0200 Subject: [PATCH 3/3] feat: Read and show for Language.Scalie.Ast.Module --- src/Language/Scalie/Ast/Module.hs | 28 ++++++++++++++++++++-------- 1 file changed, 20 insertions(+), 8 deletions(-) diff --git a/src/Language/Scalie/Ast/Module.hs b/src/Language/Scalie/Ast/Module.hs index f90f9d1..8d127aa 100644 --- a/src/Language/Scalie/Ast/Module.hs +++ b/src/Language/Scalie/Ast/Module.hs @@ -8,20 +8,32 @@ module Language.Scalie.Ast.Module (Module(..)) where import Data.Kind (Type) import Language.Scalie.Ast.Definition (Definition) import Data.Map.Implicit (ImplicitMap) -import Text.Show ( Show ) +import Text.Show (Show) 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. +-- +-- >>> 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 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 (Read (f Text), Ord (f Text), Read (f Expression), Read (f Scalie.Domain.Type)) => Read (Module f) +deriving stock instance (Show (f (ImplicitMap (Definition f)))) => Show (Module f) +deriving stock instance (Read (f (ImplicitMap (Definition f)))) => Read (Module f)