-- SPDX-FileCopyrightText: 2020 Tocqueville Group
--
-- SPDX-License-Identifier: LicenseRef-MIT-TQ

-- | Definition of the Label type and utilities
module Util.Label
  ( -- * Definitions
    Label (..)

  -- * Utilities
  , labelToText

  -- * Re-exports
  , IsLabel (..)
  ) where

import Fmt (Buildable(..), pretty)
import Text.Show (Show(..))

import Util.TypeLits

--------------------------------------------------------------------------------
-- Definitions
--------------------------------------------------------------------------------

-- | Proxy for a label type that includes the 'KnownSymbol' constraint
data Label (name :: Symbol) where
  Label :: KnownSymbol name => Label name

deriving stock instance Eq (Label name)

instance Show (Label name) where
  show :: Label name -> String
show label :: Label name
label = "Label " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Label name -> String
forall a b. (Buildable a, FromBuilder b) => a -> b
pretty Label name
label

instance (KnownSymbol name, s ~ name) => IsLabel s (Label name) where
  fromLabel :: Label name
fromLabel = Label name
forall (name :: Symbol). KnownSymbol name => Label name
Label

instance Buildable (Label name) where
  build :: Label name -> Builder
build Label = String -> Builder
forall p. Buildable p => p -> Builder
build (String -> Builder) -> String -> Builder
forall a b. (a -> b) -> a -> b
$ Proxy name -> String
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal (Proxy name
forall k (t :: k). Proxy t
Proxy @name)

--------------------------------------------------------------------------------
-- Utilities
--------------------------------------------------------------------------------

-- | Utility function to get the 'Text' representation of a 'Label'
labelToText :: Label name -> Text
labelToText :: Label name -> Text
labelToText = Label name -> Text
forall a b. (Buildable a, FromBuilder b) => a -> b
pretty