GTable.hs

{-# Language OverloadedStrings #-}
{-# Language DefaultSignatures #-}
{-# Language TypeOperators #-}
{-# Language FlexibleContexts #-}
{-# Language DeriveGeneric #-}
{-# Language DeriveAnyClass #-}
{-# Language RankNTypes #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE AllowAmbiguousTypes #-}

import Reflex.Dom
import GHC.Generics
import Data.Data
import Data.Typeable
import Data.Proxy
import Data.Generics.Text
import Data.Text
 
data Color  = Red   | Green  | Blue deriving (Eq, Show, Enum, Ord, Data)
data Width  = Thin  | Normal | Fat  deriving (Eq, Show, Enum, Ord, Data)
data Height = Short | Medium | Tall deriving (Eq, Show, Enum, Ord, Data)

data Object = Object { color  :: Color
                     , width  :: Width 
                     , height :: Height } deriving (Show, Data)

-- |Signature of attribute constructors used in object
signature :: Object -> [String]
signature = gmapQ (show . toConstr)
-- toConstr :: Data a => a -> Constr
-- gmapQ :: Data a => (forall d. Data d => d -> u) -> a -> [u]
-- show :: Show a => a -> String


gmapShow :: Data a => a -> [Text]
gmapShow = gmapQ (pack . gshow)

data Record = Record { recordId :: Int, recordName :: String }
  deriving (Data, Generic)

class GSelectors rep where
  gselectors :: Proxy rep -> [(String, TypeRep)]

instance GSelectors f => GSelectors (M1 D x f) where
  gselectors _ = gselectors (Proxy :: Proxy f)

instance GSelectors f => GSelectors (M1 C x f) where
  gselectors _ = gselectors (Proxy :: Proxy f)

instance (Selector s, Typeable t) => GSelectors (M1 S s (K1 R t)) where
  gselectors _ =
    [ ( selName (undefined :: M1 S s (K1 R t) ()) , typeOf (undefined :: t) ) ]

instance (GSelectors a, GSelectors b) => GSelectors (a :*: b) where
  gselectors _ = gselectors (Proxy :: Proxy a) ++ gselectors (Proxy :: Proxy b)

instance GSelectors U1 where
  gselectors _ = []

class Selectors a where
  selectors :: a -> [(String, TypeRep)]
  default selectors :: (Generic a, GSelectors (Rep a)) => a -> [(String, TypeRep)]
  selectors _ = gselectors (Proxy :: Proxy (Rep a)) 

-- selectors (Proxy :: Proxy (Rep Record))

table :: (Generic a, MonadWidget t m, Data a, GSelectors (Rep a), Selectors a) => Dynamic t [a] -> m ()
table xsDyn = do
    el "table" $ do
      el "tr" $ do
        --el "td" $ text "name"
        --el "td" $ text "location"
        let colsDyn = constDyn $  pack.fst <$> selectors (undefined :: a) 
        simpleList colsDyn (el "td". dynText)
      simpleList xsDyn $ row
    return ()     
 
row :: (MonadWidget t m, Data a) => Dynamic t a -> m (Dynamic t [()])
row dynA = do 
  el "tr" $ do
    simpleList (gmapShow <$> dynA) (el "td" . dynText)
--    el "td" $ dynText $ (^.name) <$> dynA
--    el "td" $ display $ (^.location) <$> dynA