Set.hs

{-# OPTIONS_HADDOCK show-extensions #-}

{-# LANGUAGE
    DefaultSignatures
  , FlexibleContexts
  , FlexibleInstances
  , PolyKinds
  , ScopedTypeVariables
  , 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 Graphics.QML.DataModel.Internal.Generic.Mock

import GHC.Generics

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

  default setupColumns 
    :: ( Mock t
       , Generic t
       , GSetupColumns (Rep t)
       ) 
    => HmDelegateHandle 
    -> sing t 
    -> IO ()
  setupColumns d _ = gSetupColumns d $ from (mock :: t)
  
-- |A generic implementation for 'SetupColumns'.
class GSetupColumns f where
  gSetupColumns :: HmDelegateHandle -> 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 -> 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 (M1 t) = gSetupColumns h t

-- |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 (M1 t) = gSetupColumnIx h 0 t

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

-- |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 t = addHaskellModelRole h ix $ selName t