{-|
Module      : Data.Compat
Description : Backwards Compatibility Schemes for Arbitrary Data
Copyright   : Travis Whitaker 2019-2024
License     : MIT
Maintainer  : pi.boy.travis@gmail.com
Stability   : Provisional
Portability : Portable

See <http://programmable.computer/compatible.html> for a full exposition and
worked examples.
-}

{-# LANGUAGE ConstraintKinds
           , FlexibleContexts
           , KindSignatures
           , RankNTypes
           , ScopedTypeVariables
           , TypeFamilies
           , TypeApplications
           , TypeOperators
           #-}

module Data.Compat where

import Control.Applicative

import Data.Constraint

import Data.Kind

import Data.Proxy

-- | A class for backwards-compatible data.
class Compat a where
    -- | The predecessor for this type, i.e. the type for the data schema
    --   directly preceeding 'a'.
    type Pred a             :: Type
    -- | Any additional constraints required to yield data values. Typically
    --   this will be a class that provides a parser.
    type CompatConstraint a :: Type -> Constraint
    -- | A type for wrapping migration results. It is most useful if this type
    --   has `Alternative` and `Monad` instances, enabling the use of
    --   `getCompatible`. `Maybe` is a good first choice.
    type CompatF a          :: Type -> Type
    -- | How to migrate from a value of the preceeding schema to the current
    --   schema.
    migrate  :: Pred a -> (CompatF a) a
    continue :: Proxy a
             -> Maybe (Dict ( Compat (Pred a)
                            , (CompatConstraint a) (Pred a)
                            , CompatConstraint a ~ CompatConstraint (Pred a)
                            , CompatF a ~ CompatF (Pred a)
                            )
                      )

-- | Recursively migrate a data value to the most recent schema, if possible.
getCompatible
    :: forall a.
       ( Compat a
       , (CompatConstraint a) a
       , Alternative (CompatF a)
       , Monad (CompatF a)
       )
    => (forall c. (Compat c, (CompatConstraint a) c) => (CompatF a) c)
    -> (CompatF a) a
getCompatible :: forall a.
(Compat a, CompatConstraint a a, Alternative (CompatF a),
 Monad (CompatF a)) =>
(forall c. (Compat c, CompatConstraint a c) => CompatF a c)
-> CompatF a a
getCompatible forall c. (Compat c, CompatConstraint a c) => CompatF a c
f =
    let f' :: CompatF a a
f' = case Proxy a
-> Maybe
     (Dict
        (Compat (Pred a), CompatConstraint a (Pred a),
         CompatConstraint a ~ CompatConstraint (Pred a),
         CompatF a ~ CompatF (Pred a)))
forall a.
Compat a =>
Proxy a
-> Maybe
     (Dict
        (Compat (Pred a), CompatConstraint a (Pred a),
         CompatConstraint a ~ CompatConstraint (Pred a),
         CompatF a ~ CompatF (Pred a)))
continue (Proxy a
forall {k} (t :: k). Proxy t
Proxy :: Proxy a) of
                Maybe
  (Dict
     (Compat (Pred a), CompatConstraint a (Pred a),
      CompatConstraint a ~ CompatConstraint (Pred a),
      CompatF a ~ CompatF (Pred a)))
Nothing   -> CompatF a a
forall a. CompatF a a
forall (f :: * -> *) a. Alternative f => f a
empty
                Just Dict
  (Compat (Pred a), CompatConstraint a (Pred a),
   CompatConstraint a ~ CompatConstraint (Pred a),
   CompatF a ~ CompatF (Pred a))
Dict -> (forall c.
 (Compat c, CompatConstraint (Pred a) c) =>
 CompatF (Pred a) c)
-> CompatF (Pred a) (Pred a)
forall a.
(Compat a, CompatConstraint a a, Alternative (CompatF a),
 Monad (CompatF a)) =>
(forall c. (Compat c, CompatConstraint a c) => CompatF a c)
-> CompatF a a
getCompatible CompatF a c
CompatF (Pred a) c
forall c. (Compat c, CompatConstraint a c) => CompatF a c
forall c.
(Compat c, CompatConstraint (Pred a) c) =>
CompatF (Pred a) c
f CompatF a (Pred a) -> (Pred a -> CompatF a a) -> CompatF a a
forall a b. CompatF a a -> (a -> CompatF a b) -> CompatF a b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Pred a -> CompatF a a
forall a. Compat a => Pred a -> CompatF a a
migrate
    in CompatF a a
forall c. (Compat c, CompatConstraint a c) => CompatF a c
f CompatF a a -> CompatF a a -> CompatF a a
forall a. CompatF a a -> CompatF a a -> CompatF a a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> CompatF a a
f'