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

View File

@ -1,6 +1,9 @@
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE FunctionalDependencies #-}
module Types.Value module Types.Value
( Value(..) ( Value(..)
, Valuable(..) , Valuable(..)
, WitnessFor(..)
) where ) where
import Prelude hiding (String) import Prelude hiding (String)
@ -86,3 +89,34 @@ instance Valuable a => Valuable [a] where
fromValue = \case fromValue = \case
List a -> map fromValue a List a -> map fromValue a
_ -> error "unexpected" _ -> 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