Get.hs

{-# OPTIONS_HADDOCK show-extensions #-}

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

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

Indexing data types by columns.
-}

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

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

import Control.Exception
import Control.Monad
import Data.Proxy
import Data.Text (Text, unpack)
import Foreign.C.Types
import GHC.Generics
import Numeric.Natural

-- |A class of types with columns that can be indexed by an integer. A generic implementation is provided for all single constructor types.
class QtTable t where
  getColumn :: Int -> t -> IO QtVariant

  default getColumn :: (Generic t, GQtTable (Rep t)) => Int -> t -> IO QtVariant
  getColumn ix = gGetColumn ix . from  

-- |A generic implementation of 'QtTable'.
class GQtTable f  where
  gGetColumn :: Int -> f a -> IO QtVariant

-- |If only one value is available, it's returned regardless of the index.
instance QtField t => GQtTable (K1 i t) where
  gGetColumn _ (K1 v) = qtField v

-- |Meta information is skipped, and the recursion proceeds further down.
instance GQtTable f => GQtTable (M1 i t f) where
  gGetColumn ix (M1 a) = gGetColumn ix a

-- |One branch of a product type is chosen depending on the index.
instance (GCountFields a, GCountFields b, GQtTable a, GQtTable b) => GQtTable (a :*: b) where
  gGetColumn ix (a :*: b) = do
       when (ix < 0)          . throwIO $ ColumnIndexNegative    ix
       when (ix >= (na + nb)) . throwIO $ ColumnIndexOutOfBounds ix (na + nb)
       if ix < na 
          then gGetColumn  ix       a
          else gGetColumn (ix - na) b
     where na = gCountFields pa
           nb = gCountFields pb
           pa :: Proxy a = Proxy
           pb :: Proxy b = Proxy

-- |A class of types with columns that can be cast to a 'QtVariant'.
class QtField t where
  qtField :: t -> IO QtVariant

instance QtField Int where
  qtField = c_newQtInt . CInt . fromIntegral

instance QtField Double  where
  qtField = c_newQtDouble . CDouble

instance QtField String where
  qtField = newQtString

instance QtField Text where
  qtField = newQtString . unpack 

instance QtField Bool where
  qtField v = c_newQtBool $ fromIntegral b
     where b :: Int
           b = if v then 1 else 0 

-- |Integers are marshalled through QT strings rather than ints.
instance QtField Integer where
  qtField = newQtString . show

-- |Naturals are marshalled through QT strings rather than ints.
instance QtField Natural where
  qtField = newQtString . show

-- |'Nothing' is marshalled as QT null.
instance QtField t => QtField (Maybe t) where
  qtField Nothing  = c_newQtNull
  qtField (Just t) = qtField t