content: {-# LANGUAGE DataKinds             #-}
  {-# LANGUAGE MultiParamTypeClasses #-}
  {-# LANGUAGE PolyKinds             #-}
  {-# LANGUAGE TypeFamilies          #-}
  {-# LANGUAGE TypeOperators         #-}
  
  {-|
  
  Provides combinators for currying and uncurrying functions over arbitrary vinyl
  records.
  
  -}
  module Data.Vinyl.Curry where
  import           Data.Kind (Type)
  import           Data.Vinyl
  import           Data.Vinyl.Functor
  import           Data.Vinyl.XRec
  
  -- * Currying
  
  class RecordCurry ts where
    {-|
    N-ary version of 'curry' over functorial records.
  
    Example specialized signatures:
  
    @
    rcurry :: (Rec Maybe '[Int, Double] -> Bool) -> Maybe Int -> Maybe Double -> Bool
    rcurry :: (Rec (Either Int) '[Double, String, ()] -> Int) -> Either Int Double -> Either Int String -> Either Int () -> Int
    rcurry :: (Rec f '[] -> Bool) -> Bool
    @
  
    -}
    rcurry :: (Rec f ts -> a) -> CurriedF f ts a
  
  class RecordCurry' ts where
    {-|
    N-ary version of 'curry' over pure records.
  
    Example specialized signatures:
  
    @
    rcurry' :: (Rec Identity '[Int, Double] -> Bool) -> Int -> Double -> Bool
    rcurry' :: (Rec Identity '[Double, String, ()] -> Int) -> Double -> String -> () -> Int
    rcurry' :: (Rec Identity '[] -> Bool) -> Bool
    @
  
    -}
    rcurry' :: (Rec Identity ts -> a) -> Curried ts a
  
  
  instance RecordCurry '[] where
    rcurry f = f RNil
    {-# INLINABLE rcurry #-}
  instance RecordCurry' '[] where
    rcurry' f = f RNil
    {-# INLINABLE rcurry' #-}
  
  instance RecordCurry ts => RecordCurry (t ': ts) where
    rcurry f x = rcurry (\xs -> f (x :& xs))
    {-# INLINABLE rcurry #-}
  instance RecordCurry' ts => RecordCurry' (t ': ts) where
    rcurry' f x = rcurry' (\xs -> f (Identity x :& xs))
    {-# INLINABLE rcurry' #-}
  
  -- * Uncurrying
  
  {-|
  N-ary version of 'uncurry' over functorial records.
  
  Example specialized signatures:
  
  @
  runcurry :: (Maybe Int -> Maybe Double -> String) -> Rec Maybe '[Int, Double] -> String
  runcurry :: (IO FilePath -> String) -> Rec IO '[FilePath] -> String
  runcurry :: Int -> Rec f '[] -> Int
  @
  -}
  runcurry :: CurriedF f ts a -> Rec f ts -> a
  runcurry x RNil      = x
  runcurry f (x :& xs) = runcurry (f x) xs
  {-# INLINABLE runcurry #-}
  
  
  {-|
  N-ary version of 'uncurry' over pure records.
  
  Example specialized signatures:
  
  @
  runcurry' :: (Int -> Double -> String) -> Rec Identity '[Int, Double] -> String
  runcurry' :: Int -> Rec Identity '[] -> Int
  @
  
  Example usage:
  
  @
  f :: Rec Identity '[Bool, Int, Double] -> Either Int Double
  f = runcurry' $ \b x y -> if b then Left x else Right y
  @
  -}
  runcurry' :: Curried ts a -> Rec Identity ts -> a
  runcurry' x RNil               = x
  runcurry' f (Identity x :& xs) = runcurry' (f x) xs
  {-# INLINABLE runcurry' #-}
  
  -- | Apply an uncurried function to an 'XRec'.
  xruncurry :: CurriedX f ts a -> XRec f ts -> a
  xruncurry x RNil = x
  xruncurry f (x :& xs) = xruncurry (f (unX x)) xs
  {-# INLINABLE xruncurry #-}
  
  -- | Apply an uncurried function to a 'Rec' like 'runcurry' except the
  -- function enjoys a type simplified by the 'XData' machinery that
  -- strips away type-induced noise like 'Identity', 'Compose', and
  -- 'ElField'.
  runcurryX :: IsoXRec f ts => CurriedX f ts a -> Rec f ts -> a
  runcurryX f = xruncurry f . toXRec
  {-# INLINE runcurryX #-}
  
  -- * Applicative Combinators
  
  {-|
  Lift an N-ary function to work over a record of 'Applicative' computations.
  
  >>> runcurryA' (+) (Just 2 :& Just 3 :& RNil)
  Just 5
  
  >>> runcurryA' (+) (Nothing :& Just 3 :& RNil)
  Nothing
  -}
  runcurryA' :: (Applicative f) => Curried ts a -> Rec f ts -> f a
  runcurryA' f = fmap (runcurry' f) . rtraverse (fmap Identity)
  {-# INLINE runcurryA' #-}
  
  {-|
  Lift an N-ary function over types in @g@ to work over a record of 'Compose'd
  'Applicative' computations. A more general version of 'runcurryA''.
  
  Example specialized signatures:
  
  @
  runcurryA :: (g x -> g y -> a) -> Rec (Compose Maybe g) '[x, y] -> Maybe a
  @
  -}
  runcurryA :: (Applicative f) => CurriedF g ts a -> Rec (Compose f g) ts -> f a
  runcurryA f = fmap (runcurry f) . rtraverse getCompose
  {-# INLINE runcurryA #-}
  
  -- * Curried Function Types
  
  {-|
  For the list of types @ts@, @'Curried' ts a@ is a curried function type from
  arguments of types in @ts@ to a result of type @a@.
  
  >>> :kind! Curried '[Int, Bool, String] Int
  Curried '[Int, Bool, String] Int :: *
  = Int -> Bool -> [Char] -> Int
  -}
  type family Curried ts a where
    Curried '[] a = a
    Curried (t ': ts) a = t -> Curried ts a
  
  
  {-|
  For the type-level list @ts@, @'CurriedF' f ts a@ is a curried function type
  from arguments of type @f t@ for @t@ in @ts@, to a result of type @a@.
  
  >>> :kind! CurriedF Maybe '[Int, Bool, String] Int
  CurriedF Maybe '[Int, Bool, String] Int :: *
  = Maybe Int -> Maybe Bool -> Maybe [Char] -> Int
  -}
  type family CurriedF (f :: u -> Type) (ts :: [u]) a where
    CurriedF f '[] a = a
    CurriedF f (t ': ts) a = f t -> CurriedF f ts a
  
  {-|
  For the type-level list @ts@, @'CurriedX' f ts a@ is a curried function type
  from arguments of type @HKD f t@ for @t@ in @ts@, to a result of type @a@.
  
  >>> :set -XTypeOperators
  >>> :kind! CurriedX (Maybe :. Identity) '[Int, Bool, String] Int
  CurriedX (Maybe :. Identity) '[Int, Bool, String] Int :: *
  = Maybe Int -> Maybe Bool -> Maybe [Char] -> Int
  -}
  type family CurriedX (f :: u -> Type) (ts :: [u]) a where
    CurriedX f '[] a = a
    CurriedX f (t ': ts) a = HKD f t -> CurriedX f ts a
  