{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE UndecidableInstances #-}

module Text.LambdaOptions.Internal.Wrap (
    Wrap(..),
) where


import Data.Typeable
import Text.LambdaOptions.Internal.Opaque


--------------------------------------------------------------------------------


internalError :: a
internalError = error "InternalError: Text.LambdaOptions.Internal.Wrap"


--------------------------------------------------------------------------------


class Wrap r f | f -> r where
    wrap :: f -> OpaqueCallback r


instance (Monad m) => Wrap (m b) (m b) where
    wrap action opaques = case opaques of
        [] -> action
        _ -> internalError


instance (Monad m, Typeable a, Wrap (m b) f) => Wrap (m b) (a -> f) where
    wrap f opaques = case opaques of
        Opaque o : os -> case cast o of
            Just x -> let
                g = f x
                g' = wrap g
                in g' os
            Nothing -> internalError
        [] -> internalError