{-# 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 = Rep1 cmd r -> String
forall (r :: k). Rep1 cmd r -> String
forall k (cmd :: k -> *) (r :: k).
CommandNames cmd =>
cmd r -> String
cmdName (Rep1 cmd r -> String) -> (cmd r -> Rep1 cmd r) -> cmd r -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. cmd r -> Rep1 cmd r
forall (a :: k). cmd a -> Rep1 cmd a
forall k (f :: k -> *) (a :: k). Generic1 f => f a -> Rep1 f a
from1

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

instance CommandNames U1 where
  cmdName :: forall (r :: k). U1 r -> String
cmdName  U1 r
_ = String
""
  cmdNames :: forall (r :: k). Proxy (U1 r) -> [String]
cmdNames Proxy (U1 r)
_ = []

instance CommandNames (K1 i c) where
  cmdName :: forall (r :: k). K1 i c r -> String
cmdName  K1 i c r
_ = String
""
  cmdNames :: forall (r :: k). Proxy (K1 i c r) -> [String]
cmdNames Proxy (K1 i c r)
_ = []

instance Constructor c => CommandNames (M1 C c f) where
  cmdName :: forall (r :: k). M1 C c f r -> String
cmdName                            = M1 C c f r -> String
forall {k} (c :: k) k1 (t :: k -> (k1 -> *) -> k1 -> *)
       (f :: k1 -> *) (a :: k1).
Constructor c =>
t c f a -> String
forall k1 (t :: Meta -> (k1 -> *) -> k1 -> *) (f :: k1 -> *)
       (a :: k1).
t c f a -> String
conName
  cmdNames :: forall (r :: k). Proxy (M1 C c f r) -> [String]
cmdNames (Proxy (M1 C c f r)
_ :: Proxy (M1 C c f p)) = [ forall {k} (c :: k) k1 (t :: k -> (k1 -> *) -> k1 -> *)
       (f :: k1 -> *) (a :: k1).
Constructor c =>
t c f a -> String
forall (c :: Meta) k1 (t :: Meta -> (k1 -> *) -> k1 -> *)
       (f :: k1 -> *) (a :: k1).
Constructor c =>
t c f a -> String
conName @c Any c Any Any
forall a. HasCallStack => a
undefined ] -- Can we do
                                                                  -- better
                                                                  -- here?

instance CommandNames f => CommandNames (M1 D c f) where
  cmdName :: forall (r :: k). M1 D c f r -> String
cmdName                            = f r -> String
forall (r :: k). f r -> String
forall k (cmd :: k -> *) (r :: k).
CommandNames cmd =>
cmd r -> String
cmdName  (f r -> String) -> (M1 D c f r -> f r) -> M1 D c f r -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. M1 D c f r -> f r
forall k i (c :: Meta) (f :: k -> *) (p :: k). M1 i c f p -> f p
unM1
  cmdNames :: forall (r :: k). Proxy (M1 D c f r) -> [String]
cmdNames (Proxy (M1 D c f r)
_ :: Proxy (M1 D c f p)) = Proxy (f r) -> [String]
forall (r :: k). Proxy (f r) -> [String]
forall k (cmd :: k -> *) (r :: k).
CommandNames cmd =>
Proxy (cmd r) -> [String]
cmdNames (Proxy (f r)
forall {k} (t :: k). Proxy t
Proxy :: Proxy (f p))

instance CommandNames f => CommandNames (M1 S c f) where
  cmdName :: forall (r :: k). M1 S c f r -> String
cmdName                            = f r -> String
forall (r :: k). f r -> String
forall k (cmd :: k -> *) (r :: k).
CommandNames cmd =>
cmd r -> String
cmdName  (f r -> String) -> (M1 S c f r -> f r) -> M1 S c f r -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. M1 S c f r -> f r
forall k i (c :: Meta) (f :: k -> *) (p :: k). M1 i c f p -> f p
unM1
  cmdNames :: forall (r :: k). Proxy (M1 S c f r) -> [String]
cmdNames (Proxy (M1 S c f r)
_ :: Proxy (M1 S c f p)) = Proxy (f r) -> [String]
forall (r :: k). Proxy (f r) -> [String]
forall k (cmd :: k -> *) (r :: k).
CommandNames cmd =>
Proxy (cmd r) -> [String]
cmdNames (Proxy (f r)
forall {k} (t :: k). Proxy t
Proxy :: Proxy (f p))

instance (CommandNames f, CommandNames g) => CommandNames (f :+: g) where
  cmdName :: forall (r :: k). (:+:) f g r -> String
cmdName (L1 f r
x) = f r -> String
forall (r :: k). f r -> String
forall k (cmd :: k -> *) (r :: k).
CommandNames cmd =>
cmd r -> String
cmdName f r
x
  cmdName (R1 g r
y) = g r -> String
forall (r :: k). g r -> String
forall k (cmd :: k -> *) (r :: k).
CommandNames cmd =>
cmd r -> String
cmdName g r
y

  cmdNames :: forall (r :: k). Proxy ((:+:) f g r) -> [String]
cmdNames (Proxy ((:+:) f g r)
_ :: Proxy ((f :+: g) a)) =
    Proxy (f r) -> [String]
forall (r :: k). Proxy (f r) -> [String]
forall k (cmd :: k -> *) (r :: k).
CommandNames cmd =>
Proxy (cmd r) -> [String]
cmdNames (Proxy (f r)
forall {k} (t :: k). Proxy t
Proxy :: Proxy (f a)) [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++
    Proxy (g r) -> [String]
forall (r :: k). Proxy (g r) -> [String]
forall k (cmd :: k -> *) (r :: k).
CommandNames cmd =>
Proxy (cmd r) -> [String]
cmdNames (Proxy (g r)
forall {k} (t :: k). Proxy t
Proxy :: Proxy (g a))

instance (CommandNames f, CommandNames g) => CommandNames (f :*: g) where
  cmdName :: forall (r :: k). (:*:) f g r -> String
cmdName  (f r
x :*: g r
y)                  = f r -> String
forall (r :: k). f r -> String
forall k (cmd :: k -> *) (r :: k).
CommandNames cmd =>
cmd r -> String
cmdName f r
x String -> String -> String
forall a. [a] -> [a] -> [a]
++ g r -> String
forall (r :: k). g r -> String
forall k (cmd :: k -> *) (r :: k).
CommandNames cmd =>
cmd r -> String
cmdName g r
y
  cmdNames :: forall (r :: k). Proxy ((:*:) f g r) -> [String]
cmdNames (Proxy ((:*:) f g r)
_ :: Proxy ((f :*: g) a)) =
    Proxy (f r) -> [String]
forall (r :: k). Proxy (f r) -> [String]
forall k (cmd :: k -> *) (r :: k).
CommandNames cmd =>
Proxy (cmd r) -> [String]
cmdNames (Proxy (f r)
forall {k} (t :: k). Proxy t
Proxy :: Proxy (f a)) [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++
    Proxy (g r) -> [String]
forall (r :: k). Proxy (g r) -> [String]
forall k (cmd :: k -> *) (r :: k).
CommandNames cmd =>
Proxy (cmd r) -> [String]
cmdNames (Proxy (g r)
forall {k} (t :: k). Proxy t
Proxy :: Proxy (g a))

instance CommandNames f => CommandNames (Rec1 f) where
  cmdName :: forall (r :: k). Rec1 f r -> String
cmdName                          = f r -> String
forall (r :: k). f r -> String
forall k (cmd :: k -> *) (r :: k).
CommandNames cmd =>
cmd r -> String
cmdName  (f r -> String) -> (Rec1 f r -> f r) -> Rec1 f r -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rec1 f r -> f r
forall k (f :: k -> *) (p :: k). Rec1 f p -> f p
unRec1
  cmdNames :: forall (r :: k). Proxy (Rec1 f r) -> [String]
cmdNames (Proxy (Rec1 f r)
_ :: Proxy (Rec1 f p)) = Proxy (f r) -> [String]
forall (r :: k). Proxy (f r) -> [String]
forall k (cmd :: k -> *) (r :: k).
CommandNames cmd =>
Proxy (cmd r) -> [String]
cmdNames (Proxy (f r)
forall {k} (t :: k). Proxy t
Proxy :: Proxy (f p))

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

-- | Convenience wrapper for 'Command'
commandName :: CommandNames cmd => Command cmd resp -> String
commandName :: forall (cmd :: (* -> *) -> *) (resp :: (* -> *) -> *).
CommandNames cmd =>
Command cmd resp -> String
commandName (Command cmd Symbolic
cmd resp Symbolic
_ [Var]
_) = cmd Symbolic -> String
forall k (cmd :: k -> *) (r :: k).
CommandNames cmd =>
cmd r -> String
forall (r :: * -> *). cmd r -> String
cmdName cmd Symbolic
cmd