-- SPDX-FileCopyrightText: 2021 Oxhead Alpha
-- SPDX-License-Identifier: LicenseRef-MIT-OA

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

  -- * Utilities
  , labelToText

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

import Fmt (Buildable(..), pretty)
import Text.Show (Show(..), showParen, showString, shows)

import Morley.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
  showsPrec :: Int -> Label name -> ShowS
showsPrec Int
d Label name
Label = Bool -> ShowS -> ShowS
showParen (Int
d Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
app_prec) (ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ String -> ShowS
showString String
"Label @" ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
forall a. Show a => a -> ShowS
shows (Proxy name -> String
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal (forall {k} (t :: k). Proxy t
forall {t :: Symbol}. Proxy t
Proxy @name))
    where
      app_prec :: Int
app_prec = Int
10

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 name
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 (forall {k} (t :: k). Proxy t
forall {t :: Symbol}. Proxy t
Proxy @name)

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

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