{-# LANGUAGE MagicHash #-}
{-# LANGUAGE RoleAnnotations #-}
{-# LANGUAGE ViewPatterns #-}

{-|
Module: Data.Label
Description: Field label type, for use with @OverloadedLabels@.

This module provides syntax for labelling values with symbolic field names.

Given @ val :: a @, we can specify a label by using the syntax
@ #field := val @, which has type @ "field" := a @.

For instance, we can pass a record of three arguments with the syntax:

@
myRecord :: ( "field1" := Int, "field2" := Bool, "field3" := Float )
myRecord = ( #field1 := 3, #field2 := True, #field3 := 7.7 )
@

This is a simple triple of labelled types, so the order matters.    

However, this library provides functionality which will automatically
handle re-ordering fields when needed, see "Data.Generic.Labels".
-}

module Data.Label
  ( (:=)
      ( .., (:=) )
  , Label
      ( Label )
  ) where

-- base

import Data.Kind
  ( Type )
import GHC.Exts
  ( proxy# )
import GHC.OverloadedLabels
  ( IsLabel
    ( fromLabel )
  )
import GHC.TypeLits
  ( Symbol, KnownSymbol, symbolVal' )

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

-- Field labels.


-- | 'Data.Proxy.Proxy'-like label type,

-- used to pass the label name at the type-level.

--

-- With @OverloadedLabels@:

--

-- @ #foo :: Label "foo" @

data Label ( lbl :: Symbol ) = Label
type role Label nominal
instance ( lbl' ~ lbl ) => IsLabel lbl ( Label lbl' ) where
  fromLabel :: Label lbl'
fromLabel = Label lbl'
forall (lbl :: Symbol). Label lbl
Label
instance KnownSymbol lbl => Show ( Label lbl ) where
  show :: Label lbl -> String
show Label lbl
_ = String
"#" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Proxy# lbl -> String
forall (n :: Symbol). KnownSymbol n => Proxy# n -> String
symbolVal' @lbl Proxy# lbl
forall k (a :: k). Proxy# a
proxy#

-- | A type with a 'Label'.

--

-- With @OverloadedLabels@:

--

-- @ ( #bar := Just 'c' ) :: ( "bar" := Maybe Char ) @

newtype ( lbl :: Symbol ) := ( a :: Type ) = Labelled { (lbl := a) -> a
unLabel :: a }

instance ( KnownSymbol lbl, Show a ) => Show ( lbl := a ) where
  showsPrec :: Int -> (lbl := a) -> ShowS
showsPrec Int
p ( Labelled a
a ) =
    Bool -> ShowS -> ShowS
showParen ( Int
p Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
1 )
      ( String -> ShowS
showString ( Label lbl -> String
forall a. Show a => a -> String
show ( Label lbl
forall (lbl :: Symbol). Label lbl
Label @lbl ) String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" := " ) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> a -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
2 a
a )

infix 1 :=
-- | Add a 'Label' to a type.

--

-- With @OverloadedLabels@:

--

-- @ ( #bar := Just 'c' ) :: ( "bar" := Maybe Char ) @

pattern (:=) :: Label lbl -> a -> lbl := a
pattern lbl $b:= :: Label lbl -> a -> lbl := a
$m:= :: forall r (lbl :: Symbol) a.
(lbl := a) -> (Label lbl -> a -> r) -> (Void# -> r) -> r
:= a <- ( ( \ ( Labelled a ) -> LabelPair Label a ) -> LabelPair lbl a )
  where
    Label lbl
_ := a
a = a -> lbl := a
forall (lbl :: Symbol) a. a -> lbl := a
Labelled a
a
{-# COMPLETE (:=) #-}

data LabelPair lbl a = LabelPair !( Label lbl ) !a