Put witness class somewhere more central and add all instances

This commit is contained in:
Niels G. W. Serup 2024-10-06 16:37:10 +02:00
parent 206124c1ca
commit 6c6dd510d9
No known key found for this signature in database
GPG Key ID: 38EEEBCE67324F19
2 changed files with 35 additions and 8 deletions

View File

@ -1,5 +1,4 @@
{-# LANGUAGE GADTs #-}
{-# LANGUAGE FunctionalDependencies #-}
module Function
( concatStrings
, concatTexts
@ -17,7 +16,7 @@ module Function
import Prelude hiding (String, FilePath)
import Types.Values
import Types.Value (Valuable)
import Types.Value (Valuable, WitnessFor(..))
import Types.Function
import Types.Token (Token(..))
import DependencyGenerator (DepGenM, TokenableTo(..), toTupleToken, runFunction)
@ -78,12 +77,6 @@ lowerString :: TokenableTo String a => a -> DepGenM (Token String)
lowerString a = runFunction LowerString =<< toToken a
class (Show w, Lift w) => WitnessFor w t | w -> t, t -> w where
witnessValue :: w
data StringType = StringType deriving (Show, Lift)
instance WitnessFor StringType String where witnessValue = StringType
data ElemOf a where ElemOf :: WitnessFor w a => w -> ElemOf a
deriving instance Show (ElemOf a)
deriving instance Lift (ElemOf a)

View File

@ -1,6 +1,9 @@
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE FunctionalDependencies #-}
module Types.Value
( Value(..)
, Valuable(..)
, WitnessFor(..)
) where
import Prelude hiding (String)
@ -86,3 +89,34 @@ instance Valuable a => Valuable [a] where
fromValue = \case
List a -> map fromValue a
_ -> error "unexpected"
class (Show w, Lift w) => WitnessFor w t | w -> t, t -> w where
witnessValue :: w
data StringType = StringType deriving (Show, Lift)
instance WitnessFor StringType String where witnessValue = StringType
data TextType = TextType deriving (Show, Lift)
instance WitnessFor TextType Text where witnessValue = TextType
data BoolType = BoolType deriving (Show, Lift)
instance WitnessFor BoolType Bool where witnessValue = BoolType
data ImageType = ImageType deriving (Show, Lift)
instance WitnessFor ImageType Image where witnessValue = ImageType
data ImageConversionSettingsType = ImageConversionSettingsType deriving (Show, Lift)
instance WitnessFor ImageConversionSettingsType ImageConversionSettings where witnessValue = ImageConversionSettingsType
data TemplateType = TemplateType deriving (Show, Lift)
instance WitnessFor TemplateType Template where witnessValue = TemplateType
data EmptyType = EmptyType deriving (Show, Lift)
instance WitnessFor EmptyType () where witnessValue = EmptyType
data TupleType ta tb = TupleType ta tb deriving (Show, Lift)
instance (WitnessFor ta a, WitnessFor tb b) => WitnessFor (TupleType ta tb) (a, b) where witnessValue = TupleType witnessValue witnessValue
data ListType t = ListType t deriving (Show, Lift)
instance WitnessFor t a => WitnessFor (ListType t) [a] where witnessValue = ListType witnessValue