Set.hs

{-# OPTIONS_HADDOCK show-extensions #-}

{-# LANGUAGE
    DefaultSignatures
  , FlexibleContexts
  , FlexibleInstances
  , PartialTypeSignatures
  , PolyKinds
  , ScopedTypeVariables
  , TypeFamilies
  , TypeOperators
  #-}

{-|
Module      : Graphics.QML.DataModel.Internal.Generic.Set
Copyright   : (c) Marcin Mrotek, 2015
License     : BSD3
Maintainer  : marcin.jan.mrotek@gmail.com
Stability   : experimental

Setup the column names of a HaskellModel.
-}

module Graphics.QML.DataModel.Internal.Generic.Set where

import Graphics.QML.DataModel.Internal.FFI
import Graphics.QML.DataModel.Internal.Generic.Count

import Data.Proxy
import GHC.Generics

-- |A class of types that can provide a template to setup the QT HaskellModel. A generic implementation is provided for all proxyle constructor types.
class SetupColumns t where
  setupColumns :: HmDelegateHandle -> proxy t -> IO ()

  default setupColumns 
    :: ( Generic t, GSetupColumns f, (Rep t ~ f a) ) 
    => HmDelegateHandle 
    -> proxy t 
    -> IO ()
  setupColumns d _ = gSetupColumns d p
    where p :: Proxy (Rep t) = Proxy
  
-- |A generic implementation for 'SetupColumns'.
class GSetupColumns f where
  gSetupColumns :: HmDelegateHandle -> proxy (f a) -> IO ()

-- |A helper class for the generic implementation for 'SetupColumns', starts its work at a particular index.
class GSetupColumnIx f where
  gSetupColumnIx :: HmDelegateHandle -> Int -> proxy (f a) -> IO ()

-- |Meta information for a whole datatype is skipped, and the recursion proceeds further down.
instance GSetupColumns f => GSetupColumns (M1 D t f) where
  gSetupColumns h _ = gSetupColumns h p
    where p :: Proxy (f _) = Proxy

-- |Meta information for a constructor is skipped, and 'SetupColumnIx' is used starting at index 0.
instance GSetupColumnIx f => GSetupColumns (M1 C t f) where
  gSetupColumns h _ = gSetupColumnIx h 0 p
    where p :: Proxy (f _) = Proxy

-- |Setups both terms of the product.
instance ( GCountFields a
         , GCountFields b
         , GSetupColumnIx a
         , GSetupColumnIx b
         ) => GSetupColumnIx (a :*: b) where
  gSetupColumnIx h ix _ = do
     gSetupColumnIx h  ix                   a
     gSetupColumnIx h (ix + gCountFields a) b
   where a :: Proxy (a _) = Proxy
         b :: Proxy (b _) = Proxy

-- |A model role name is added accoring to the record selector's name.
instance Selector t => GSetupColumnIx (M1 S t f) where
  gSetupColumnIx h ix _ = addHaskellModelRole h ix $ selName u
    where u :: M1 S t f _ = undefined