{-# Language MultiParamTypeClasses,TypeOperators , DataKinds,GADTs,TypeFamilies#-}
{-
fold a hlist of kliesli types
passing previous return type into next input
needs a hlist type with adjacently coupled types...
this can be generated by a zipWIth . tail pattern
-}

--foldl (>>=) :: (Foldable t, Monad m) => m a -> t (a -> m a) -> m a
-- a -> m b,b -> m c etc

infixr 6 :-:

data HList xs where
 HEmpty :: HList '[]
 (:-:)  :: x -> HList xs -> HList (x ': xs)

type XList m xs = HList (FX m xs)

-- should really use Map, but would have to defunctionalise and write Uncurry...
type family FX m (xs :: [*]) :: [*] where
 FX m (x ': y ': '[]) = '[x -> m y]
 FX m (x ': y ':  xs) =  (x -> m y) ': FX m (y ': xs)

eg :: Monad m => XList m '[Int,String,(String,Int),[String],String]
eg = (\int
  -> return $ show int)
 :-: (\string
  -> return $ (reverse string,read string))
 :-: (\(string,int)
  -> return $ replicate int string)
 :-: (\strings
  -> return $ concat strings)
 :-: HEmpty

type family Head xs where
 Head (x ': _) = x

type family Last xs where
 Last (x ': '[]) = x
 Last (x ': xs) = Last xs

class RunXList m xs where
 runXList :: XList m xs -> (Head xs -> m (Last xs))
{-
runXList (x :-: HEmpty) = x
runXList (x :-: xs) = x >>= (runXList xs)
-}

{-
    * Couldn't match type `Head xs' with `Head xs0'
      Expected type: XList m xs -> Head xs -> m (Last xs)
        Actual type: XList m xs0 -> Head xs0 -> m (Last xs0)
      NB: `Head' is a non-injective type family
      The type variable `xs0' is ambiguous
    * In the ambiguity check for `runXList'
      To defer the ambiguity check to use sites, enable AllowAmbiguousTypes
      When checking the class method:
        runXList :: forall (m :: * -> *) (xs :: [*]).
                    RunXList m xs =>
                    XList m xs -> Head xs -> m (Last xs)
      In the class declaration for `RunXList'
   |
64 |  runXList :: XList m xs -> (Head xs -> m (Last xs))
   |  ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
-}