{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE KindSignatures #-}

module Data.Name.Internal where

import Control.DeepSeq ( NFData )
import Data.Text ( Text )
import GHC.Generics ( Generic )
import GHC.TypeLits


-- | The 'Named' is a wrapper around any 'Data.Text' that identifies the type of
-- 'Data.Text' via the @nameOf@ phantom symbol type, as well as a usage specified
-- by the @style@ type parameter.  Use of 'Named' should always be preferred to
-- using a raw 'Data.Text' (or 'String').

newtype Named (style :: NameStyle) (nameOf :: Symbol) = Named { forall (style :: NameStyle) (nameOf :: NameStyle).
Named style nameOf -> Text
named :: Text }
  deriving ((forall x. Named style nameOf -> Rep (Named style nameOf) x)
-> (forall x. Rep (Named style nameOf) x -> Named style nameOf)
-> Generic (Named style nameOf)
forall x. Rep (Named style nameOf) x -> Named style nameOf
forall x. Named style nameOf -> Rep (Named style nameOf) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall (style :: NameStyle) (nameOf :: NameStyle) x.
Rep (Named style nameOf) x -> Named style nameOf
forall (style :: NameStyle) (nameOf :: NameStyle) x.
Named style nameOf -> Rep (Named style nameOf) x
$cfrom :: forall (style :: NameStyle) (nameOf :: NameStyle) x.
Named style nameOf -> Rep (Named style nameOf) x
from :: forall x. Named style nameOf -> Rep (Named style nameOf) x
$cto :: forall (style :: NameStyle) (nameOf :: NameStyle) x.
Rep (Named style nameOf) x -> Named style nameOf
to :: forall x. Rep (Named style nameOf) x -> Named style nameOf
Generic, Named style nameOf -> ()
(Named style nameOf -> ()) -> NFData (Named style nameOf)
forall a. (a -> ()) -> NFData a
forall (style :: NameStyle) (nameOf :: NameStyle).
Named style nameOf -> ()
$crnf :: forall (style :: NameStyle) (nameOf :: NameStyle).
Named style nameOf -> ()
rnf :: Named style nameOf -> ()
NFData, NonEmpty (Named style nameOf) -> Named style nameOf
Named style nameOf -> Named style nameOf -> Named style nameOf
(Named style nameOf -> Named style nameOf -> Named style nameOf)
-> (NonEmpty (Named style nameOf) -> Named style nameOf)
-> (forall b.
    Integral b =>
    b -> Named style nameOf -> Named style nameOf)
-> Semigroup (Named style nameOf)
forall b.
Integral b =>
b -> Named style nameOf -> Named style nameOf
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
forall (style :: NameStyle) (nameOf :: NameStyle).
NonEmpty (Named style nameOf) -> Named style nameOf
forall (style :: NameStyle) (nameOf :: NameStyle).
Named style nameOf -> Named style nameOf -> Named style nameOf
forall (style :: NameStyle) (nameOf :: NameStyle) b.
Integral b =>
b -> Named style nameOf -> Named style nameOf
$c<> :: forall (style :: NameStyle) (nameOf :: NameStyle).
Named style nameOf -> Named style nameOf -> Named style nameOf
<> :: Named style nameOf -> Named style nameOf -> Named style nameOf
$csconcat :: forall (style :: NameStyle) (nameOf :: NameStyle).
NonEmpty (Named style nameOf) -> Named style nameOf
sconcat :: NonEmpty (Named style nameOf) -> Named style nameOf
$cstimes :: forall (style :: NameStyle) (nameOf :: NameStyle) b.
Integral b =>
b -> Named style nameOf -> Named style nameOf
stimes :: forall b.
Integral b =>
b -> Named style nameOf -> Named style nameOf
Semigroup)


-- | The NameStyle specifies how the name itself is styled.
--
--  * The 'UTF8' default style is orthogonal to a normal String or Text.
--
--  * The 'CaseInsensitive' style indicates that uppercase ASCII characters are
--    equivalent to their lowercase form.
--
--  * The 'Secure' style is case sensitive, but does not reveal the full contents
--    unless the specific "secureNameBypass" accessor function is used.  This is
--    useful for storing secrets (e.g. passphrases, access tokens, etc.) that
--    should not be fully visible in log messages and other miscellaneous output.
--
-- These styles will be described in more detail below.

type NameStyle = Symbol