{-# LANGUAGE TypeFamilies, FlexibleContexts #-} {- | Module : Type.Yoko.FunA Copyright : (c) The University of Kansas 2011 License : BSD3 Maintainer : nicolas.frisby@gmail.com Stability : experimental Portability : see LANGUAGE pragmas (... GHC) "Type.Yoko.Fun" functions that /implicitly/ return an applicative functor. The implicitness means that the 'Rng' type instance is not expected to include the applicative functor. -} module Type.Yoko.FunA (Idiom, DomainA(..), applyA, applyAD) where import Type.Yoko.Fun import Type.Yoko.Universe type family Idiom (fn :: * -> *) :: * -> * newtype DomainA fn t = AppABy (fn t -> Dom fn t -> Idiom fn (Rng fn t)) applyA :: (t ::: DomainA fn) => fn t -> Dom fn t -> Idiom fn (Rng fn t) applyA = applyAD inhabits applyAD :: DomainA fn t -> fn t -> Dom fn t -> Idiom fn (Rng fn t) applyAD (AppABy f) = f