PortNameM.hs

{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE DefaultSignatures #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE TypeSynonymInstances #-}
{-# LANGUAGE NoImplicitPrelude #-}

module PortNameM where

import GHC.TypeLits
import GHC.Generics
import Data.Proxy
import Clash.Prelude

newtype PortNameM a = PortNameM (Const [PortName] a)
                    deriving (Functor, Applicative)

runPortNameM :: PortNameM a -> [PortName]
runPortNameM (PortNameM (Const m)) = m

primField :: String -> PortNameM a
primField name = PortNameM $ Const [PortName name]

field :: String -> PortNameM a -> PortNameM a
field name m = PortNameM $ Const [PortField name (runPortNameM m)]

class HasPortNames a where
    portNames :: PortNameM a
    --default portNames :: (Generic a, GHasPortNames (Rep a)) => PortNameM a
    --portNames = to <$> gPortNames

instance HasPortNames (BitVector a) where
    portNames = primField ""

instance HasPortNames (Unsigned a) where
    portNames = primField ""

instance HasPortNames Bool where
    portNames = primField ""

instance (HasPortNames a, HasPortNames b) => HasPortNames (a,b) where
    portNames = (,) <$> field "field1" portNames <*> field "field2" portNames




getPortNames :: forall a. HasPortNames a => String -> Proxy a -> PortName
getPortNames name Proxy = PortField name (runPortNameM names)
  where
    names :: PortNameM a
    names = portNames