{-# LANGUAGE DataKinds            #-}
{-# LANGUAGE DefaultSignatures    #-}
{-# LANGUAGE FlexibleContexts     #-}
{-# LANGUAGE FlexibleInstances    #-}
{-# LANGUAGE PolyKinds            #-}
{-# LANGUAGE ScopedTypeVariables  #-}
{-# LANGUAGE TypeApplications     #-}
{-# LANGUAGE TypeOperators        #-}
{-# LANGUAGE UndecidableInstances #-}

module Test.StateMachine.ConstructorName
  ( CommandNames(..)
  , commandName
  )
  where

import           Data.Kind
                   (Type)
import           Data.Proxy
                   (Proxy(Proxy))
import           GHC.Generics
                   ((:*:)((:*:)), (:+:)(L1, R1), C, Constructor, D,
                   Generic1, K1, M1, Rec1, Rep1, S, U1, conName, from1,
                   unM1, unRec1)
import           Prelude

import           Test.StateMachine.Types
                   (Command(..))

------------------------------------------------------------------------

-- | The names of all possible commands
--
-- This is used for things like tagging, coverage checking, etc.
class CommandNames (cmd :: k -> Type) where
  -- | Name of this particular command
  cmdName  :: cmd r -> String

  -- | Name of all possible commands
  cmdNames :: Proxy (cmd r) -> [String]

  default cmdName :: (Generic1 cmd, CommandNames (Rep1 cmd)) => cmd r -> String
  cmdName = cmdName . from1

  default cmdNames :: forall r. CommandNames (Rep1 cmd) => Proxy (cmd r) -> [String]
  cmdNames _ = cmdNames (Proxy @(Rep1 cmd r))

instance CommandNames U1 where
  cmdName  _ = ""
  cmdNames _ = []

instance CommandNames (K1 i c) where
  cmdName  _ = ""
  cmdNames _ = []

instance Constructor c => CommandNames (M1 C c f) where
  cmdName                            = conName
  cmdNames (_ :: Proxy (M1 C c f p)) = [ conName @c undefined ] -- Can we do
                                                                  -- better
                                                                  -- here?

instance CommandNames f => CommandNames (M1 D c f) where
  cmdName                            = cmdName  . unM1
  cmdNames (_ :: Proxy (M1 D c f p)) = cmdNames (Proxy :: Proxy (f p))

instance CommandNames f => CommandNames (M1 S c f) where
  cmdName                            = cmdName  . unM1
  cmdNames (_ :: Proxy (M1 S c f p)) = cmdNames (Proxy :: Proxy (f p))

instance (CommandNames f, CommandNames g) => CommandNames (f :+: g) where
  cmdName (L1 x) = cmdName x
  cmdName (R1 y) = cmdName y

  cmdNames (_ :: Proxy ((f :+: g) a)) =
    cmdNames (Proxy :: Proxy (f a)) ++
    cmdNames (Proxy :: Proxy (g a))

instance (CommandNames f, CommandNames g) => CommandNames (f :*: g) where
  cmdName  (x :*: y)                  = cmdName x ++ cmdName y
  cmdNames (_ :: Proxy ((f :*: g) a)) =
    cmdNames (Proxy :: Proxy (f a)) ++
    cmdNames (Proxy :: Proxy (g a))

instance CommandNames f => CommandNames (Rec1 f) where
  cmdName                          = cmdName  . unRec1
  cmdNames (_ :: Proxy (Rec1 f p)) = cmdNames (Proxy :: Proxy (f p))

------------------------------------------------------------------------

-- | Convenience wrapper for 'Command'
commandName :: CommandNames cmd => Command cmd resp -> String
commandName (Command cmd _ _) = cmdName cmd