Hi.

Here's a way that seems to work for me. I haven't tested in detail.
There may be problems, or also easier ways to achieve the same. The
DataKinds extension isn't essential. I've just used it for fun.

Cheers,
  Andres

-- 
Andres Löh, Haskell Consultant
Well-Typed LLP, http://www.well-typed.com
{-# LANGUAGE TypeFamilies, ConstraintKinds, KindSignatures, TypeSynonymInstances, DataKinds #-}
module Resolve where

import GHC.Exts
import Control.Applicative
import Control.Monad

data DataBase = DataBase -- specific type not relevant here

data Resolved = Res | Unres

-- provides operation to transform an unresolved `Foo_ Unres` to a resolved `Foo_ Res`
class Resolvable e where
    type ResFun e (a :: Resolved) :: *           -- replace the 'Resolved' argument in 'e' with 'a'
    type ResArg e (a :: Resolved) :: Constraint  -- force the 'Resolved' argument in 'e' to be 'a'
    resolve :: (ResArg e 'Unres) => DataBase -> e -> Either String (ResFun e 'Res)

-- trivial /resolvable/ type
data Foo_ (r :: Resolved) = Foo
  deriving Show

instance Resolvable (Foo_ r) where
    type ResFun (Foo_ r) a = Foo_ a
    type ResArg (Foo_ r) a = r ~ a
    resolve _ x = return Foo

-- Maybe (polymorphic 0 or 1 element container)
resolveMaybe :: (Resolvable e, ResArg e 'Unres) => DataBase -> Maybe e -> Either String (Maybe (ResFun e 'Res))
resolveMaybe db (Just x) = Just <$> resolve db x
resolveMaybe db Nothing  = pure Nothing

instance Resolvable e => Resolvable (Maybe e) where
    type ResFun (Maybe e) a = Maybe (ResFun e a)
    type ResArg (Maybe e) a = ResArg e a
    resolve db x = resolveMaybe db x

-- Pairs
resolvePair :: (Resolvable e0, Resolvable e1, ResArg e0 'Unres, ResArg e1 'Unres)
            => DataBase -> (e0, e1) -> Either String (ResFun e0 'Res, ResFun e1 'Res)
resolvePair db (x,y) = (,) <$> resolve db x <*> resolve db y

instance (Resolvable e0, Resolvable e1) => Resolvable (e0, e1) where
    type ResFun (e0, e1) a = (ResFun e0 a, ResFun e1 a)
    type ResArg (e0, e1) a = (ResArg e0 a, ResArg e1 a)
    resolve db x = resolvePair db x
_______________________________________________
Glasgow-haskell-users mailing list
Glasgow-haskell-users@haskell.org
http://www.haskell.org/mailman/listinfo/glasgow-haskell-users

Reply via email to