module Data.Shapely.Normal.Coercible
where
import Data.Shapely.Category
import Data.Shapely.Classes
import Data.Shapely.Utilities
import Data.Shapely.Spine
import Data.Proxy.Kindness
class (Shapely a, Shapely b)=> Isomorphic a b where
coerce :: a -> b
instance (Unapplied (Proxy txy) t, CoercibleWith (Proxy t,()) txy b)=> Isomorphic txy b where
coerce a = coerceWith (unappliedOf a, ()) a
class (SpineOf ts, Shapely a, Shapely b)=> CoercibleWith ts a b where
coerceWith :: ts -> a -> b
instance (Shapely a, Shapely b, CoercibleNormalWith ts (Normal a) (Normal b))=> CoercibleWith ts a b where
coerceWith ts a = coerceNormalWith ts $$ a
class (SpineOf ts)=> CoercibleNormalWith ts na nb where
coerceNormalWith :: ts -> na -> nb
instance (SpineOf ts)=> CoercibleNormalWith ts () () where
coerceNormalWith _ = id
instance (CoerceTerms ts ts x y, CoercibleNormalWith ts as bs)=> CoercibleNormalWith ts (x,as) (y,bs) where
coerceNormalWith ts (x,as) = (coerceTermWith ts ts x, coerceNormalWith ts as)
instance (CoercibleNormalWith a as as', CoercibleNormalWith a bs bs')=> CoercibleNormalWith a (Either as bs) (Either as' bs') where
coerceNormalWith a' = bimap (coerceNormalWith a') (coerceNormalWith a')
class (SpineOf tsOrig, SpineOf tsBeingChecked)=> CoerceTerms tsBeingChecked tsOrig a b where
coerceTermWith :: tsBeingChecked -> tsOrig -> a -> b
instance (SpineOf tsOrig)=> CoerceTerms () tsOrig a a where
coerceTermWith _ _ = id
instance (SpineOf (Proxy x, ts), SpineOf tsOrig
, IsOfBaseType x a bool, TryingCoerceTerm bool ts tsOrig a b
)=> CoerceTerms (Proxy x, ts) tsOrig a b where
coerceTermWith = coerceTermWithOrContinue (Proxy :: Proxy bool) . snd
instance (empty ~ (), fa ~ f a, fb ~ f b, SpineOf ts, Functor f, CoerceTerms ts ts a b)=> CoerceTerms empty ts fa fb where
coerceTermWith _ ts = fmap (coerceTermWith ts ts)
class TryingCoerceTerm (aIsOfBaseType :: Bool) ts tsOrig a b where
coerceTermWithOrContinue :: Proxy aIsOfBaseType -> ts -> tsOrig -> a -> b
instance (CoercibleWith tsOrig a b)=> TryingCoerceTerm True ts tsOrig a b where
coerceTermWithOrContinue _ _ = coerceWith
instance (CoerceTerms ts tsOrig a b, SpineOf ts, SpineOf tsOrig)=> TryingCoerceTerm False ts tsOrig a b where
coerceTermWithOrContinue _ = coerceTermWith