{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE ExplicitNamespaces #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}
module Versioning.Upgrade
( Adapt (..)
, Upgrade
, upgrade
, Downgrade
, downgrade
)
where
import Data.Kind (Type)
import Versioning.Base
import Versioning.Internal.Equality (type (==))
class Adapt (v :: V) (w :: V) (a :: V -> Type) where
adapt :: a v -> a w
upgrade :: forall v w a. Upgrade v w a => a v -> a w
upgrade = upgrade' @(v == w)
type Upgrade v w a = Upgrade' (v == w) v w a
class Upgrade' (eq :: Bool) (v :: V) (w :: V) (a :: V -> Type) where
upgrade' :: a v -> a w
instance (v ~ w) => Upgrade' 'True v w a where
upgrade' x = x
instance (Adapt v (VSucc v) a, Upgrade' (VSucc v == w) (VSucc v) w a)
=> Upgrade' 'False v w a where
upgrade' x = upgrade' @(VSucc v == w) @(VSucc v) @w (adapt @v @(VSucc v) x)
downgrade :: forall v w a. Downgrade v w a => a v -> a w
downgrade = downgrade' @(v == w)
type Downgrade v w a = Downgrade' (v == w) v w a
class Downgrade' (eq :: Bool) (v :: V) (w :: V) (a :: V -> Type) where
downgrade' :: a v -> a w
instance (v ~ w) => Downgrade' 'True v w a where
downgrade' x = x
instance (Adapt v (VPred v) a, Downgrade' (VPred v == w) (VPred v) w a)
=> Downgrade' 'False v w a where
downgrade' x = downgrade' @(VPred v == w) @(VPred v) @w (adapt @v @(VPred v) x)