{-# LANGUAGE ConstraintKinds, DataKinds,GADTs,FlexibleContexts, FlexibleInstances,KindSignatures,MultiParamTypeClasses #-}
-- | functions to help making lists for consumption on the R side
module RlangQQ.MakeRecord where

import GHC.TypeLits -- prevents a panic lookupVers2 <<details unavailable>> with ghc 7.6. Fixed later probably from #7502
import Control.Monad.State
import Control.Monad.Identity
import Data.HList.CommonMain
import HListExtras

-- | convert a haskell list into a record with labels all of type \"\". The length
-- of the list is decided by the (type of the) first argument which is a 'HNat'
listToRecN :: ListToRecN __ (n :: HNat) x r => Proxy n -> [x] -> Record r
listToRecN n xs = Record $ hMap2 NoLabel $ flip evalState xs $ hSequence $ hReplicate n comp
    where comp = do
                x : xs' <- get
                return () :: State [x] ()
                put (xs' `asTypeOf` xs)
                return (x `asTypeOf` head xs)

type ListToRecN __ (n :: HNat) x r = (HReplicate n (StateT [x] Identity x),
    HSequence (StateT [x] Identity) (HReplicateR n (StateT [x] Identity x)) __,
    HMap2 NoLabel __ r)



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