{-# LANGUAGE DataKinds #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE MultiParamTypeClasses #-}
-- | 'hMap' 'FN' drops the inner Tagged, which was
-- just used to keep track of the variable name on the
-- R side.
--
-- it could be replaced by unsafeCoerce with the
-- right type signature
module RlangQQ.FN where
import Data.HList.CommonMain
import GHC.TypeLits
data FN = FN

instance (a ~ (Tagged (t :: k) (Tagged (t2::k) x)), b ~Tagged t x) => ApplyAB FN a b where
    applyAB _ (Tagged (Tagged x)) = Tagged x

data NoLabel = NoLabel
instance (la ~ Tagged "" a) => ApplyAB NoLabel a la where
    applyAB _ x = Tagged x