Put witness class somewhere more central and add all instances
This commit is contained in:
parent
206124c1ca
commit
6c6dd510d9
|
@ -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)
|
||||||
|
|
|
@ -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
|
||||||
|
|
Loading…
Reference in New Issue