    {-|
    Copyright  :  (C) 2013-2016, University of Twente
                      2022     , QBayLogic B.V.
    License    :  BSD2 (see the file LICENSE)
    Maintainer :  QBayLogic B.V. <devops@qbaylogic.com>
    -}

    {-# LANGUAGE CPP #-}
    {-# LANGUAGE GADTs #-}
    {-# LANGUAGE TemplateHaskellQuotes #-}

    -- Annotations are not allowed in safe Haskell
    -- {-# LANGUAGE Safe #-}

    {-# OPTIONS_HADDOCK show-extensions #-}

    module Clash.Promoted.Symbol
      (SSymbol (..), ssymbolProxy, ssymbolToString)
    where

    import Language.Haskell.TH.Syntax
    import GHC.Show     (appPrec)
    import GHC.TypeLits (KnownSymbol, Symbol, symbolVal)

    import Clash.Annotations.Primitive (hasBlackBox)

    -- | Singleton value for a type-level string @s@
    data SSymbol (s :: Symbol) where
      SSymbol :: KnownSymbol s => SSymbol s

    {-# ANN SSymbol hasBlackBox #-}

    instance KnownSymbol s => Lift (SSymbol (s :: Symbol)) where
    --  lift :: t -> Q Exp
      lift :: forall (m :: Type -> Type). Quote m => SSymbol s -> m Exp
    lift SSymbol s
    t = Exp -> m Exp
    forall a. a -> m a
    forall (f :: Type -> Type) a. Applicative f => a -> f a
    pure (Exp -> Type -> Exp
    AppTypeE (Name -> Exp
    ConE 'SSymbol) Type
    tt)
        where
          tt :: Type
    tt = TyLit -> Type
    LitT (String -> TyLit
    StrTyLit (SSymbol s -> String
    forall (s :: Symbol). SSymbol s -> String
    ssymbolToString SSymbol s
    t))

    #if MIN_VERSION_template_haskell(2,17,0)
      liftTyped :: forall (m :: Type -> Type).
    Quote m =>
    SSymbol s -> Code m (SSymbol s)
    liftTyped = m Exp -> Code m (SSymbol s)
    forall a (m :: Type -> Type). Quote m => m Exp -> Code m a
    unsafeCodeCoerce (m Exp -> Code m (SSymbol s))
    -> (SSymbol s -> m Exp) -> SSymbol s -> Code m (SSymbol s)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . SSymbol s -> m Exp
    forall t (m :: Type -> Type). (Lift t, Quote m) => t -> m Exp
    forall (m :: Type -> Type). Quote m => SSymbol s -> m Exp
    lift
    #elif MIN_VERSION_template_haskell(2,16,0)
      liftTyped = unsafeTExpCoerce . lift
    #endif

    instance Show (SSymbol s) where
      showsPrec :: Int -> SSymbol s -> ShowS
    showsPrec Int
    d s :: SSymbol s
    s@SSymbol s
    SSymbol = Bool -> ShowS -> ShowS
    showParen (Int
    d Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    > Int
    appPrec) (ShowS -> ShowS) -> ShowS -> ShowS
    forall a b. (a -> b) -> a -> b
    $
        String -> ShowS
    showString String
    "SSymbol @" ShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> ShowS
    forall a. Show a => a -> ShowS
    shows (SSymbol s -> String
    forall (s :: Symbol). SSymbol s -> String
    ssymbolToString SSymbol s
    s)

    {-# INLINE ssymbolProxy #-}
    -- | Create a singleton symbol literal @'SSymbol' s@ from a proxy for
    -- /s/
    ssymbolProxy :: KnownSymbol s => proxy s -> SSymbol s
    ssymbolProxy :: forall (s :: Symbol) (proxy :: Symbol -> Type).
    KnownSymbol s =>
    proxy s -> SSymbol s
    ssymbolProxy proxy s
    _ = SSymbol s
    forall (s :: Symbol). KnownSymbol s => SSymbol s
    SSymbol

    {-# INLINE ssymbolToString #-}
    -- | Reify the type-level 'Symbol' @s@ to it's term-level 'String'
    -- representation.
    ssymbolToString :: SSymbol s -> String
    ssymbolToString :: forall (s :: Symbol). SSymbol s -> String
    ssymbolToString s :: SSymbol s
    s@SSymbol s
    SSymbol = SSymbol s -> String
    forall (n :: Symbol) (proxy :: Symbol -> Type).
    KnownSymbol n =>
    proxy n -> String
    symbolVal SSymbol s
    s