packages feed

named-text 1.0.1.0 → 1.1.0.0

raw patch · 4 files changed

+887/−81 lines, 4 filesdep +hspecdep +named-textdep +parameterized-utilsdep ~basedep ~prettyprinterdep ~sayablePVP ok

version bump matches the API change (PVP)

Dependencies added: hspec, named-text, parameterized-utils, tasty, tasty-ant-xml, tasty-checklist, tasty-hspec

Dependency ranges changed: base, prettyprinter, sayable

API changes (from Hackage documentation)

- Data.Name: instance Control.DeepSeq.NFData (Data.Name.Named style sym)
- Data.Name: instance Data.Hashable.Class.Hashable (Data.Name.Named style sym)
- Data.Name: instance Data.Name.ConvertName Data.Name.UTF8 "component" "instance component"
- Data.Name: instance Data.Name.ConvertName Data.Name.UTF8 "git.branch" "git.branch|ref"
- Data.Name: instance Data.Name.ConvertName Data.Name.UTF8 "git.ref" "git.branch|ref"
- Data.Name: instance Data.Name.IsText (Data.Name.Named Data.Name.CaseInsensitive sym)
- Data.Name: instance Data.Name.IsText (Data.Name.Named style sym)
- Data.Name: instance Data.String.IsString (Data.Name.Named Data.Name.CaseInsensitive sym)
- Data.Name: instance Data.String.IsString (Data.Name.Named style sym)
- Data.Name: instance GHC.Base.Semigroup (Data.Name.Named style sym)
- Data.Name: instance GHC.Classes.Eq (Data.Name.Named style sym)
- Data.Name: instance GHC.Classes.Ord (Data.Name.Named style sym)
- Data.Name: instance GHC.Generics.Generic (Data.Name.Named style sym)
- Data.Name: instance GHC.TypeLits.KnownSymbol ty => Prettyprinter.Internal.Pretty (Data.Name.Name ty)
- Data.Name: instance GHC.TypeLits.KnownSymbol ty => Prettyprinter.Internal.Pretty (Data.Name.Named Data.Name.Secure ty)
+ Data.Name: instance (GHC.TypeLits.KnownSymbol ty, Data.Name.NameText style) => Prettyprinter.Internal.Pretty (Data.Name.Named style ty)
+ Data.Name: instance Control.DeepSeq.NFData (Data.Name.Named style nameOf)
+ Data.Name: instance Data.Hashable.Class.Hashable (Data.Name.Named style nameOf)
+ Data.Name: instance Data.Name.IsText (Data.Name.Named Data.Name.CaseInsensitive nameOf)
+ Data.Name: instance Data.Name.IsText (Data.Name.Named style nameOf)
+ Data.Name: instance Data.Name.NameText Data.Name.Secure
+ Data.Name: instance Data.String.IsString (Data.Name.Named Data.Name.CaseInsensitive nameOf)
+ Data.Name: instance Data.String.IsString (Data.Name.Named style nameOf)
+ Data.Name: instance GHC.Base.Semigroup (Data.Name.Named style nameOf)
+ Data.Name: instance GHC.Classes.Eq (Data.Name.Named style nameOf)
+ Data.Name: instance GHC.Classes.Ord (Data.Name.Named style nameOf)
+ Data.Name: instance GHC.Generics.Generic (Data.Name.Named style nameOf)
+ Data.Name: instance Text.Sayable.Sayable "show" (Data.Name.Named style nm) => GHC.Show.Show (Data.Name.Named style nm)
+ Data.Name: nameLength :: Named style nm -> Natural
+ Data.Name: nullName :: Named style nm -> Bool
- Data.Name: caselessName :: Named CaseInsensitive sym -> Text
+ Data.Name: caselessName :: Named CaseInsensitive nameOf -> Text
- Data.Name: class ConvertName style origTy newTy
+ Data.Name: class NameText style => ConvertName style origTy newTy
- Data.Name: class ConvertNameStyle inpStyle outStyle nameTy
+ Data.Name: class (NameText inpStyle, IsText (Named outStyle nameTy)) => ConvertNameStyle inpStyle outStyle nameTy
- Data.Name: class (KnownNat (AllowedNameType nty ntl), DisallowedNameType nty ntl ntl) => ValidNames (nty :: Symbol) (ntl :: [Symbol])
+ Data.Name: class (KnownNat (AllowedNameType nameOf ntl), DisallowedNameType nameOf ntl ntl) => ValidNames (nameOf :: Symbol) (ntl :: [Symbol])
- Data.Name: data Named (style :: NameStyle) (sym :: Symbol)
+ Data.Name: data Named (style :: NameStyle) (nameOf :: Symbol)
- Data.Name: name :: Name sym -> Text
+ Data.Name: name :: Name nameOf -> Text
- Data.Name: nameOf :: KnownSymbol sym => Named style sym -> Proxy# sym -> String
+ Data.Name: nameOf :: KnownSymbol nameOf => Named style nameOf -> Proxy# nameOf -> String
- Data.Name: nameProxy :: KnownSymbol sym => Named style sym -> Proxy sym
+ Data.Name: nameProxy :: KnownSymbol nameOf => Named style nameOf -> Proxy nameOf
- Data.Name: secureName :: Named Secure sym -> Text
+ Data.Name: secureName :: Named Secure nameOf -> Text
- Data.Name: secureNameBypass :: Named Secure sym -> Text
+ Data.Name: secureNameBypass :: Named Secure nameOf -> Text
- Data.Name: styleProxy :: KnownSymbol style => Named style sym -> Proxy style
+ Data.Name: styleProxy :: KnownSymbol style => Named style nameOf -> Proxy style
- Data.Name: validName :: ValidNames nty ntl => Proxy ntl -> Name nty -> Text
+ Data.Name: validName :: ValidNames nameOf ntl => Proxy ntl -> Name nameOf -> Text
- Data.Name: viewSomeNameStyle :: (forall (s :: Symbol). KnownSymbol s => Named s nameTy -> r) -> SomeNameStyle nameTy -> r
+ Data.Name: viewSomeNameStyle :: (forall (s :: Symbol). (KnownSymbol s, NameText s) => Named s nameTy -> r) -> SomeNameStyle nameTy -> r

Files

CHANGELOG.md view
@@ -1,5 +1,16 @@ # Revision history for named-text +## 1.1.0.0 -- 2022-12-28++* Added tests and enhanced haddock.+* Re-organized implementation, removing extraneous definitions.+* The `name` and `caselessName` functions are deprecated in favor of `nameText`.+* General, overlappable `Prettyprinter` `Pretty` instance for all `Named`.+* Changed from `Named style sym` to `Named style nameOf`.+* Fixed `convertStyle` to use the proper `fromText` instance.+* Added `NameText` constraint to `viewSomeNameStyle` first argument signature.+* Added `nameLength` and `nullName` utility functions.+ ## 1.0.1.0 -- 2022-12-23  * Specific GHC support range for GHC 8.8--9.4
Data/Name.hs view
@@ -1,3 +1,88 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeApplications #-}+{-|++The 'Data.Name' type is designed to be used in place of plain 'String' or+'Data.Text' types.  Fundamentally 'Data.Name' is an extension of 'Data.Text', but+it includes two type-level parameters that help to manage the underlying data: a+style parameter and a nameOf parameter.++ * The style parameter is used to control various functionality and validation+   around the contained Text type.  For example, one style is CaseInsensitive,+   which allows comparisons to be done independently of ASCII case.++ * The nameOf parameter is a phantom type string which ensures that two different+   strings aren't inadvertently swapped or combined.  Any transformation from one+   nameOf to another nameOf must be intentional.++== Example++For a more complete example, consider a @login@ form which takes an email as the+username and a password.  Without the Data.Name module, the type signature might+be:++>    login :: String -> String -> IO Bool++There are a number of deficiencies that can be identified for this+implementation, including:++* Which argument is the email username, which is the password?++* Is there any protection against simply printing the password to stdout?++* Can these protections be extended to the code calling @login@ and not just+  observed within the @login@ function itself?++* Email addresses are typically not case sensitive: does the @login@ function+  provide the appropriate case handling?++Using 'Data.Name', the declaration would look more like:++> login :: Named CaseInsensitive "email" -> Named Secure "password" -> IO Bool++There are a number of advantages that can be observed here:++* The arguments are self-identifying.  No need to try to remember which was used+  for what purpose.++* The email is treated as a case-insensitive value, both within @login@ but also+  automatically in any other uses elsewhere.  Setting this value automatically+  applies case insensitivity conversions, and comparisons are always case+  independent.++* The password is secured against simply printing it or retrieving the value to+  use unsafely elsewhere.  There is a special operation to return the actual+  underlying Text from a secure name, which will presumably be very carefully+  used only by the @login@ implementation itself.++* Zero runtime cost (other than where needed, such as case translation).++== Alternatives:++One typical alternative approach is to use a @newtype@ wrapper around 'Data.Text'+or 'String' to provide the type level safety.  This is not a bad approach, but+this module seeks to provide the following additional benefits over a simple+@newtype@:++* New names do not need a separate declaration, with associated instance+  declarations:  simply use a new type string.++* Names are parameterized over both style and identity, with different conversion+  abilities for both.  Similar functionality could be established for a @newtype@+  but this would result in either a duplication of effort for each new @newtype@+  declared this way, or else a parameterization of a generic @newtype@ in the+  same general manner as provided by this module (and 'Data.Name' *is* simply a+  @newtype@ at the core).++Another approach is to use the 'Data.Tagged'.  This module is highly similar to+'Data.Tagged', but this module's 'Named' type has two parameters and the+underlying type is always 'Data.Text'.  This module can therefore be considered a+specialization of the generic capabilities of 'Data.Tagged' but more customized+for representing textual data.+-}++ {-# LANGUAGE DataKinds #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE ExplicitNamespaces #-}@@ -18,19 +103,57 @@ {-# LANGUAGE UndecidableInstances #-}  module Data.Name-  ( type Name-  , Named-  , name, nameOf, nameProxy, styleProxy, caselessName-  , NameStyle, UTF8, CaseInsensitive, Secure-  , HasName, myName-  , NameText, nameText+  (+    -- * Core type+    Named+  , nameOf+  , nameProxy+  , styleProxy   , SomeName(SomeName), viewSomeName+  , HasName, myName+    -- ** Style management+    --+    -- | Defines the style type parameter and some well-known styles directly+    -- supported by this module.  Users may define additional styles as needed.+  , NameStyle   , SomeNameStyle(SomeNameStyle), viewSomeNameStyle-  , SecureName, secureName, secureNameBypass+    -- ** Creating a Name+    --+    -- | The 'Named' type is an instance of 'IsString', so a name can be created+    -- from a string via 'fromString'.  In addition, this module defines an+    -- 'IsText' class with a 'fromText' method that operates in a parallel+    -- fashion.   , IsText(fromText)+    -- ** Conversions   , ConvertName(convertName)   , ConvertNameStyle(convertStyle)+    -- ** Extraction and rendering+    --+    -- | For rendering, the 'sayable' package is preferred (as provided by the+    -- 'Sayable' instances, which is an extension of the "prettyprinter" package+    -- (and users desiring a "prettyprinter" output can extract that from the+    -- 'sayable' representation).+  , NameText, nameText++    -- * Regular (UTF-8) Names+  , UTF8+  , type Name+  , name++    -- * Case Insensitive Names+  , CaseInsensitive+  , caselessName++    -- * Secure Names+  , Secure+  , SecureName, secureName, secureNameBypass++    -- * Constraining allowed names   , ValidNames, validName++    -- * Utility operations+  , nameLength+  , nullName ) where @@ -47,16 +170,19 @@ import qualified Prettyprinter as PP import           Text.Sayable +#if !MIN_VERSION_base(4,16,0)+import           Numeric.Natural+#endif --- | The 'Named' is a wrapper around any 'Text' that identifies the type of--- 'Text' via the @sym@ 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 'Text' (or 'String').+-- | 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) (sym :: Symbol) =-  Named { named :: Text }+newtype Named (style :: NameStyle) (nameOf :: Symbol) = Named { named :: Text }   deriving (Eq, Ord, Generic, NFData, Semigroup) + -- | The NameStyle specifies how the name itself is styled. -- --  * The 'UTF8' default style is orthogonal to a normal String or Text.@@ -64,189 +190,320 @@ --  * 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+--  * The 'Secure' style is case sensitive, but does not reveal the full contents --    unless the specific "secureName" 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-type UTF8 = "UTF8" :: NameStyle-type CaseInsensitive = "CaseInsensitive" :: NameStyle-type Secure = "SECURE!" :: NameStyle -instance Hashable (Named style sym)+instance Hashable (Named style nameOf)  --- | Retrieve the @sym@ type parameter (the "what am I") of a Named as a text+-- | Retrieve the @nameOf@ type parameter (the "what am I") of a Named as a text -- value-nameOf :: KnownSymbol sym => Named style sym -> Proxy# sym -> String++nameOf :: KnownSymbol nameOf => Named style nameOf -> Proxy# nameOf -> String nameOf _ = symbolVal'  -nameProxy :: KnownSymbol sym => Named style sym -> Proxy sym+-- | Retrieve a proxy for the @nameOf@ parameter of 'Named'.++nameProxy :: KnownSymbol nameOf => Named style nameOf -> Proxy nameOf nameProxy _ = Proxy -styleProxy :: KnownSymbol style => Named style sym -> Proxy style+-- | Retrieve a proxy for the @style@ parameter of 'Named'.++styleProxy :: KnownSymbol style => Named style nameOf -> Proxy style styleProxy _ = Proxy  -instance {-# OVERLAPPABLE #-} IsString (Named style sym) where+instance {-# OVERLAPPABLE #-} IsString (Named style nameOf) where   fromString = Named . fromString  +-- | The 'IsText' class provides similar functionality to the 'IsString' class,+-- but with 'Data.Text' sources instead of 'String' sources.  Defining an+-- instance of this class allows the use of 'fromText' to convert from+-- 'Data.Text' to the target type (which does not necessarily need to be a+-- 'Named' type, and this generic class should be deprecated in favor of a+-- generic implementation the the "text" library).+ class IsText a where fromText :: Text -> a-instance {-# OVERLAPPABLE #-} IsText (Named style sym) where+instance {-# OVERLAPPABLE #-} IsText (Named style nameOf) where   fromText = Named  -class ConvertName style origTy newTy where+-- | Conversion from a 'Named' with one @nameOf@ to a separate @nameOf@ must be+-- done explicitly; the recommended method is via an instance of the+-- 'ConvertName' class, which provides the 'convertName' method to perform the+-- requested conversion.  If there should not be a conversion between the two+-- 'Named' types, no 'ConvertName' class should be defined, and users should+-- refrain from providing an alternative explicit function to perform this+-- conversion.++class NameText style => ConvertName style origTy newTy where   convertName :: Named style origTy -> Named style newTy-  convertName = fromText . named+  convertName = fromText . nameText -class ConvertNameStyle inpStyle outStyle nameTy where++-- | A 'Named' can be converted from one @style@ to another with an instance of+-- the 'ConvertNameStyle' class.  If no conversion should be supported, no+-- instance should be defined.  Users are highly recommended to use the+-- convertStyle method (instead of a separate manual conversion function) to+-- ensure proper conversions are performed.++class ( NameText inpStyle+      , IsText (Named outStyle nameTy)+      )+      => ConvertNameStyle inpStyle outStyle nameTy where   convertStyle :: Named inpStyle nameTy -> Named outStyle nameTy-  convertStyle = fromText . named+  convertStyle = fromText . nameText  --- | For an @"info"@ 'saytag' (and possibly others), a 'Name' doesn't include its--- label.  Normally, it shows the label followed by the text itself.  The Sayable--- defers to the Prettyprinting instance for actual representation.+-- | A general class that can be used to extract the Text back out of a name.+-- This should be the preferred method of obtaining the raw Text, and should be+-- used carefully as all of the protections provided by this module are no longer+-- available for that raw Text.  In addition, no instance of this class is+-- provided where the name should not be extractable, and this method may extract+-- a modified form of the text (e.g. the Secure namestyle will return a masked+-- version of the original Text).++class NameText style where+  -- | nameText is used to retrieve the original 'Data.Text' text from a 'Named'+  -- object of the specified style.  This should be the main method used to+  -- extract the Text from a Named, but it should be used carefully because the+  -- protections offered by the 'Named' type will no longer be available for the+  -- raw Text.+  nameText :: Named style nm -> Text+  nameText = named++-- | Some objects have (contain) an associated name that identifies or labels+-- that object.  If they do, they can declare the 'HasName' constraint, and use+-- its 'myName' method to reconstitute the 'Named' from the object.++class HasName x style nm | x -> style, x -> nm where+  -- | myName can be used to extract the associated 'Named' from an object.+  myName :: x -> Named style nm+++----------------------------------------------------------------------+-- Rendering++-- | For an @"info"@ @saytag@ (and possibly others), a 'Name' doesn't include its+-- label and simply shows the 'Data.Text' as would be rendered by+-- "prettyprinter".+ instance NameText style => Sayable "info" (Named style nm) where   sayable = Saying . PP.pretty . nameText+++-- | Generically the rendered version includes the textual representation of the+-- 'nameOf' parameter followed by the 'Data.Text' itself.+ instance {-# OVERLAPPABLE #-} (PP.Pretty (Named style nm)                               ) => Sayable tag (Named style nm)  where sayable = Saying . PP.pretty  +-- | There is also a 'Show' method; this is *not* the inverse of a 'Read', and in+-- fact there is no 'Read' instance for 'Named'.  The 'Sayable' instance is+-- preferred over 'Show', but 'Show' is provided for default considerations such+-- as test failure reporting. -----------------------------------------------------------------------+instance (Sayable "show" (Named style nm)) => Show (Named style nm) where+  show = sez @"show" --- | The Name type is for the standard/most commonly used style which is--- orthogonal to a normal String or Text. -type Name = Named UTF8+-- | This is the general pretty rendering for a Named object.  This can be+-- overriden for specific types or styles for a different rendering. -name :: Name sym -> Text-name = named+instance  {-# OVERLAPPABLE #-} ( KnownSymbol ty+                               , NameText style+                               )+                               => PP.Pretty (Named style ty) where+  pretty nm = (PP.pretty $ nameOf nm proxy#)+              <+> PP.squotes (PP.pretty (nameText nm))  -instance IsList (Name s) where-  type Item (Name s) = Item Text-  fromList = fromText . fromList-  toList = toList . name+----------------------------------------------------------------------+-- Utility operations -instance ConvertName UTF8 a a where convertName = id-instance ConvertName UTF8 "component" "instance component"-instance ConvertName UTF8 "git.branch" "git.branch|ref"-instance ConvertName UTF8 "git.ref" "git.branch|ref"+-- | Returns the length of the underlying 'Data.Text' -instance KnownSymbol ty => PP.Pretty (Name ty) where-  pretty nm = (PP.pretty $ nameOf nm proxy#) <+> PP.squotes (PP.pretty (name nm))+nameLength :: Named style nm -> Natural+nameLength = toEnum . T.length . named +-- | Returns true if the name value is empty. +nullName :: Named style nm -> Bool+nullName = T.null . named++ ---------------------------------------------------------------------- +-- | The 'SomeName' data type is used to existentially hide the identification+-- type parameter for 'Named' objects.  This is usually used when names of+-- different types are mixed together in some container or other name-agnostic+-- interface.+ data SomeName =   forall (s :: Symbol) . KnownSymbol s => SomeName (Name s) ++-- | The 'viewSomeName' function is used to project the 'Named' object with its+-- identification type parameter existentially recovered to a function that will+-- consume that 'Named' object and return some sort of result.+ viewSomeName :: (forall (s :: Symbol) . KnownSymbol s => Name s -> r) -> SomeName -> r viewSomeName f (SomeName n) = f n  +-- | The 'SomeNameStyle' data type is used to existentially hide the style type+-- of 'Named' objects.  This is usually used when names of different styles are+-- mixed together in some container or other style-agnostic interface.+ data SomeNameStyle nameTy =   forall (s :: Symbol)   . (KnownSymbol s, NameText s)   => SomeNameStyle (Named s nameTy) -viewSomeNameStyle :: (forall (s :: Symbol) . KnownSymbol s => Named s nameTy -> r)++-- | The 'viewSomeNameStyle' function is used to project the 'Named' object with+-- its style type existentially recovered to a function that will consume that+-- 'Named' object and return some sort of result.++viewSomeNameStyle :: (forall (s :: Symbol) . (KnownSymbol s, NameText s) => Named s nameTy -> r)                   -> SomeNameStyle nameTy -> r viewSomeNameStyle f (SomeNameStyle n) = f n   ----------------------------------------------------------------------+-- * UTF8 Names --- | Some objects have (contain) an associated name.  If they do, they can--- declare the HasName constraint, and use myName to reconsistute the name from--- the object.+-- | The UTF8 type alias is useable as the @style@ parameter of a 'Named' type.+-- The type-string form may also be used but the type alias is designed to allow+-- abstraction from the raw type-string value. -class HasName x style nm | x -> style, x -> nm where-  myName :: x -> Named style nm+type UTF8 = "UTF8" :: NameStyle +-- | The Name type is for the standard/most commonly used style which is+-- orthogonal to a normal String or Text.  Because this is the most frequently+-- used form of 'Named', it has a type alias to shorten the usage references. --- | A general class that can be used to extract the Text back out of a name.+type Name = Named UTF8 -class NameText style where-  nameText :: Named style nm -> Text-  nameText = named+{-# DEPRECATED name "Use nameText instead" #-}+name :: Name nameOf -> Text+name = nameText ++instance IsList (Name s) where+  type Item (Name s) = Item Text+  fromList = fromText . fromList+  toList = toList . nameText++instance ConvertName UTF8 a a where convertName = id+ instance NameText UTF8   ----------------------------------------------------------------------+-- * CaseInsensitive Named objects -instance {-# OVERLAPPING #-} IsString (Named CaseInsensitive sym) where+-- | The CaseInsensitive style of Named objects will allow case-insensitive ASCII+-- comparisons between objects.  On creation, all text is converted to lowercase,+-- so the original input case is not preserved on extraction or rendering.++type CaseInsensitive = "CaseInsensitive" :: NameStyle++instance {-# OVERLAPPING #-} IsString (Named CaseInsensitive nameOf) where   fromString = Named . T.toLower . fromString -instance {-# OVERLAPPING #-} IsText (Named CaseInsensitive sym) where+instance {-# OVERLAPPING #-} IsText (Named CaseInsensitive nameOf) where   fromText = Named . T.toLower  instance KnownSymbol ty => PP.Pretty (Named CaseInsensitive ty) where   pretty nm = (PP.pretty $ nameOf nm proxy#)               <+> PP.surround (PP.pretty (caselessName nm)) "«" "»" -instance NameText CaseInsensitive where-  nameText = named+instance NameText CaseInsensitive -caselessName :: Named CaseInsensitive sym -> Text-caselessName = named+{-# DEPRECATED caselessName "Use nameText instead" #-}+caselessName :: Named CaseInsensitive nameOf -> Text+caselessName = nameText   ----------------------------------------------------------------------+-- * Secure Named objects --- | The SecureName is like Name, but its display form does not reveal--- the full name.+-- | The Secure style of Named objects masks the internal text on extraction or+-- rendering to avoid leaking information.  The actual internal text can be+-- retrieved only with the explicit 'secureNameBypass' function. +type Secure = "SECURE!" :: NameStyle++-- | The SecureName is like Name, but its display form does not reveal the full+-- name.  The use of the 'nameText' extractor or any of the renderers will+-- occlude a portion of the secure name to avoid revealing it in its entirety.+ type SecureName = Named Secure + -- | The secureName accessor is used to obtain the name field from a Secure -- Named.  This is the normal accessor for a Secure Named and will occlude a -- portion of the extracted name for protection.  For those specific cases where -- the full Secure Named text is needed, the 'secureNameBypass' accessor should -- be used instead. -secureName :: Named Secure sym -> Text+{-# DEPRECATED secureName "Use nameText instead" #-}+secureName :: Named Secure nameOf -> Text secureName nm = if T.length (named nm) < 5                 then T.replicate 8 "#"                 else ((T.take 2 $ named nm)                       <> T.replicate (T.length (named nm) - 4) "#"                       <> T.reverse (T.take 2 $ T.reverse $ named nm)) + -- | The secureNameBypass accessor is used to obtain the raw Text from a Secure--- Named; this essentially bypasses the security protection and should only be+-- Named; this essentially BYPASSES THE SECURITY PROTECTION and should only be -- used in the limited cases when the raw form is absolutely needed. -secureNameBypass :: Named Secure sym -> Text+secureNameBypass :: Named Secure nameOf -> Text secureNameBypass = named --- instance NameText Secure sym   <-- explicitly not defined!--instance KnownSymbol ty => PP.Pretty (Named Secure ty) where-  pretty nm = (PP.pretty $ nameOf nm proxy#)-              <+> PP.squotes (PP.pretty (named nm))---- Note that there should be no instance of ToJSON for a SecureName!+instance NameText Secure where+  nameText = secureName   ----------------------------------------------------------------------+-- Constraining allowed names+ -- | The ValidNames constraint can be used to specify the list of allowed names--- for a parameterized name argument.+-- for a parameterized name argument.  For example:+--+-- > foo :: ValidNames n '[ "right", "correct" ] => Name n -> a+--+-- The above allows @foo@ to be called with a @Name "right"@ or a @Name+-- "correct"@, but if it is called with any other 'Named' @nameOf@ parameter then+-- a compilation error will be generated indicating "the supplied @nameOf@ type+-- parameter is not in the allowed Names".+--+-- All instances of this class are pre-defined by this module and the user should+-- not need to create any instances.  -class ( KnownNat (AllowedNameType nty ntl)-      , DisallowedNameType nty ntl ntl+class ( KnownNat (AllowedNameType nameOf ntl)+      , DisallowedNameType nameOf ntl ntl       )-  => ValidNames (nty :: Symbol) (ntl :: [Symbol]) where-  validName :: Proxy ntl -> Name nty -> Text+  => ValidNames (nameOf :: Symbol) (ntl :: [Symbol]) where+  -- | The validName method is used to extract the text form of a 'Name' for+  -- which @nameOf@ is a member of the valid names specified by the @ntl@ type+  -- list.  It corresponds to 'nameText' while also providing the validation+  -- of the extraction.+  validName :: Proxy ntl -> Name nameOf -> Text   ----------------------------------------------------------------------
named-text.cabal view
@@ -1,6 +1,6 @@ cabal-version:      2.4 name:               named-text-version:            1.0.1.0+version:            1.1.0.0 synopsis:           A parameterized named text type and associated functionality. description:   .@@ -56,3 +56,22 @@                     , sayable >= 1.0 && < 1.1                     , text     exposed-modules:  Data.Name+++test-suite namedTests+    import:           bldspec+    default-language: Haskell2010+    type:             exitcode-stdio-1.0+    hs-source-dirs:   test+    main-is:          Test.hs+    build-depends:    base+                    , hspec+                    , named-text+                    , parameterized-utils >= 2.1 && < 2.2+                    , prettyprinter+                    , sayable+                    , tasty >= 1.4 && < 1.5+                    , tasty-ant-xml >= 1.1 && < 1.2+                    , tasty-checklist >= 1.0 && < 1.1+                    , tasty-hspec >= 1.2 && < 1.3+                    , text
+ test/Test.hs view
@@ -0,0 +1,519 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE MagicHash #-}+{-# LANGUAGE MonoLocalBinds #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE PatternSynonyms #-}+{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE UndecidableInstances #-}+{-# OPTIONS_GHC -fno-warn-orphans #-}++import           Data.Name+import           Data.Parameterized.Context ( pattern Empty, pattern (:>) )+import           Data.Proxy ( Proxy(Proxy) )+import           Data.String ( IsString(fromString) )+import           Data.Text ( Text )+import qualified Data.Text as T+import           GHC.Exts ( proxy#, IsList(fromList, toList) )+import qualified Prettyprinter as PP+import           Text.Sayable++import           Test.Hspec+import           Test.Tasty+import           Test.Tasty.Checklist+import           Test.Tasty.Hspec+import           Test.Tasty.Runners.AntXML+++main :: IO ()+main = tests >>= defaultMainWithIngredients (antXMLRunner : defaultIngredients)++tests :: IO TestTree+tests = testGroup "Named" <$> sequence+        [+          testCreate+        , testRender+        , testSemigroup+        , testIsList+        , testConversions+        , testValidNames+        , testSomeNames+        , testHasName+        , testUtilities+        ]+++instance TestShow Text+instance Sayable "test" (Named s n)+         => TestShow (Named s n) where testShow = sez @"test"+instance TestShow (Proxy UTF8) where testShow _ = "Proxy :: \"UTF8\""+instance TestShow (Proxy CaseInsensitive) where testShow _ = "Proxy :: !Case"+instance TestShow (Proxy Secure) where testShow _ = "Proxy :: Secure"+instance TestShow [SomeName] where testShow = testShowList+instance TestShow SomeName where testShow = viewSomeName testShow+++testCreate :: IO TestTree+testCreate = testSpec "Named Creation" $+  describe "creation, properties, and extraction of Named" $ do++    it "CR1 creates UTF8 from IsText" $+      withChecklist "CR1" $+      fromText @(Named UTF8 "CR1") ("test text" :: Text)+      `checkValues`+      (Empty+       :> Val "overloaded equivalent text value" id "test text"+       :> Got "case sensitive text value" (/= "Test Text")+       :> Val "name parameter value" (\n -> nameOf n proxy#) "CR1"+       :> Val "style proxy" styleProxy (Proxy :: Proxy "UTF8")+       :> Val "extracted text" nameText ("test text" :: Text)+      )++    it "CR2 creates UTF8 from IsString" $+      withChecklist "CR2" $+      fromString @(Named UTF8 "CR2") ("test string" :: String)+      `checkValues`+      (Empty+       :> Val "overloaded equivalent string value" id "test string"+       :> Val "name parameter value" (\n -> nameOf n proxy#) "CR2"+       :> Val "style proxy" styleProxy (Proxy :: Proxy "UTF8")+       :> Val "extracted text" nameText ("test string" :: Text)+      )++    it "CR3 creates CaseInsensitive from IsText" $+      withChecklist "CR3" $+      fromText @(Named CaseInsensitive "CR3") ("Test teXT" :: Text)+      `checkValues`+      (Empty+       :> Val "overloaded equivalent text value" id "tesT tExt"+       :> Val "name parameter value" (\n -> nameOf n proxy#) "CR3"+       :> Val "style proxy" styleProxy (Proxy :: Proxy CaseInsensitive)+       :> Val "extracted text" nameText ("test text" :: Text)+      )++    it "CR4 creates CaseInsensitive from IsString" $+      withChecklist "CR4" $+      fromString @(Named CaseInsensitive "CR4") ("TEst STring" :: String)+      `checkValues`+      (Empty+       :> Val "overloaded equivalent string value" id "teST sTring"+       :> Val "name parameter value" (\n -> nameOf n proxy#) "CR4"+       :> Val "style proxy" styleProxy (Proxy :: Proxy CaseInsensitive)+       :> Val "extracted text" nameText ("test string" :: Text)+      )++    it "CR5 creates Secure from IsText" $+      withChecklist "CR5" $+      fromText @(Named Secure "CR5") ("test text" :: Text)+      `checkValues`+      (Empty+       :> Val "overloaded equivalent text value" id "test text"+       :> Got "case sensitive secure value" (/= "Test Text")+       :> Val "name parameter value" (\n -> nameOf n proxy#) "CR5"+       :> Val "style proxy" styleProxy (Proxy :: Proxy Secure)+       :> Val "extracted text" nameText ("te#####xt" :: Text)+       :> Val "security bypass text" secureNameBypass ("test text" :: Text)+      )++    it "CR6 creates Secure from IsString" $+      withChecklist "CR6" $+      fromString @(Named Secure "CR6") ("TEst STring" :: String)+      `checkValues`+      (Empty+       :> Val "overloaded equivalent string value" id "TEst STring"+       :> Val "name parameter value" (\n -> nameOf n proxy#) "CR6"+       :> Val "style proxy" styleProxy (Proxy :: Proxy Secure)+       :> Val "extracted text" nameText ("TE#######ng" :: Text)+       :> Val "security bypass text" secureNameBypass ("TEst STring" :: Text)+      )++    it "CR7 creates short Secure" $+      withChecklist "CR7" $+      ("z" :: Named Secure "CR7")+      `checkValues`+      (Empty+       :> Val "overloaded equivalent text value" id "z"+       :> Val "name parameter value" (\n -> nameOf n proxy#) "CR7"+       :> Val "style proxy" styleProxy (Proxy :: Proxy Secure)+       :> Val "extracted text" nameText ("########" :: Text)+       :> Val "security bypass text" secureNameBypass ("z" :: Text)+      )+++testRender :: IO TestTree+testRender = testSpec "Named Rendering" $+  describe "rendering of Named" $ do++  it "CR10 render UTF8 via Sayable" $+    withChecklist "CR10" $+    ("test text" :: Name "CR10")+    `checkValues`+    (Empty+     :> Val "as sayable" (sez @"test") "CR10 'test text'"+     :> Val "as sayable info" (sez @"info") "test text"+    )++  it "CR11 render UTF8 via Prettyprinter" $+    withChecklist "CR11" $+    fromText @(Named "UTF8" "CR11") ("test of text" :: Text)+    `checkValues`+    (Empty+     :> Val "as pretty" (show . PP.pretty) "CR11 'test of text'"+    )++  it "CR12 render UTF8 via Show" $+    withChecklist "CR12" $+    fromText @(Named "UTF8" "CR12") ("test of text" :: Text)+    `checkValues`+    (Empty+     :> Val "as show" show "CR12 'test of text'"+    )++  it "CR13 render CaseInsensitive via Sayable" $+    withChecklist "CR13" $+    ("tEST TeXt" :: Named CaseInsensitive "CR13")+    `checkValues`+    (Empty+     :> Val "as sayable" (sez @"test") "CR13 «test text»"+     :> Val "as sayable info" (sez @"info") "test text"+    )++  it "CR14 render CaseInsensitive via Prettyprinter" $+    withChecklist "CR14" $+    fromText @(Named CaseInsensitive "CR14") ("test OF text" :: Text)+    `checkValues`+    (Empty+     :> Val "as pretty" (show . PP.pretty) "CR14 «test of text»"+    )++  it "CR15 render CaseInsensitive via Show" $+    withChecklist "CR15" $+    fromText @(Named CaseInsensitive "CR15") ("TEST OF TEXT" :: Text)+    `checkValues`+    (Empty+     :> Val "as show" show "CR15 «test of text»"+    )++  it "CR16 render Secure via Sayable" $+    withChecklist "CR16" $+    ("tEST TeXt" :: Named Secure "CR16")+    `checkValues`+    (Empty+     :> Val "as sayable" (sez @"test") "CR16 'tE#####Xt'"+     :> Val "as sayable info" (sez @"info") "tE#####Xt"+    )++  it "CR17 render Secure via Prettyprinter" $+    withChecklist "CR17" $+    fromText @(Named Secure "CR17") ("test OF text" :: Text)+    `checkValues`+    (Empty+     :> Val "as pretty" (show . PP.pretty) "CR17 'te########xt'"+    )++  it "CR18 render Secure via Show" $+    withChecklist "CR18" $+    fromText @(Named Secure "CR18") ("TEST OF TEXT" :: Text)+    `checkValues`+    (Empty+     :> Val "as show" show "CR18 'TE########XT'"+    )++  it "CR19 render short Secure via Sayable" $+    withChecklist "CR19" $+    ("X" :: Named Secure "CR19")+    `checkValues`+    (Empty+     :> Val "as sayable" (sez @"test") "CR19 '########'"+     :> Val "as sayable info" (sez @"info") "########"+    )+++testSemigroup :: IO TestTree+testSemigroup = testSpec "Named Semigroup" $+  describe "semigroup of Named" $ do++  it "CR20 UTF8 semigroup" $+    withChecklist "CR20" $+    (fromText @(Named UTF8 "CR20") ("more test text" :: Text)+     <> " and still more")+    `checkValues`+    (Empty+     :> Val "raw value" id "more test text and still more"+     :> Val "as sayable" (sez @"test") "CR20 'more test text and still more'"+    )++  it "CR21 CaseInsensitive semigroup" $+    withChecklist "CR21" $+    (fromText @(Named CaseInsensitive "CR21") ("mORE teST TexT" :: Text)+     <> " and STILL more")+    `checkValues`+    (Empty+     :> Val "implicitly constructed full form" id "more test text and still more"+     :> Val "as sayable" (sez @"test") "CR21 «more test text and still more»"+    )++  it "CR22 Secure semigroup" $+    withChecklist "CR22" $+    (fromText @(Named Secure "CR22") ("more test text" :: Text)+     <> " and still more")+    `checkValues`+    (Empty+     :> Val "implicitly constructed full form" id "more test text and still more"+     :> Val "as sayable" (sez @"test") "CR22 'mo#########################re'"+    )++testIsList :: IO TestTree+testIsList = testSpec "Named IsList" $+  describe "IsList of Named" $ do++  it "CR30 UTF8 IsList" $+    withChecklist "CR30" $+    (fromList "list of text" :: Name "CR30")+    `checkValues`+    (Empty+     :> Val "matches implicit construction" id "list of text"+     :> Val "as sayable" (sez @"test") "CR30 'list of text'"+     :> Val "as extracted text" nameText "list of text"+     :> Val "as list" toList ['l','i','s','t',' ','o','f',' ','t','e','x','t']+    )++  -- Note: no IsList instance for CaseInsensitive or Secure++testConversions :: IO TestTree+testConversions = testSpec "Named Conversions" $ do++  describe "Named nameOf conversions" $ do+    -- n.b. these tests use the "instance ConvertName" below.++    it "CR40 UTF8 default conversion" $+      withChecklist "CR40" $+      (convertName (fromText "list of text" :: Name "CR40") :: Name "CR40-2")+      `checkValues`+      (Empty+       :> Val "matches implicit construction" id "list of text"+       :> Val "as sayable" (sez @"test") "CR40-2 'list of text'"+       :> Val "as extracted text" nameText "list of text"+      )++    it "CR41 UTF8 explicit conversion" $+      withChecklist "CR41" $+      (convertName (fromText "list of text" :: Name "CR41") :: Name "CR41-3")+      `checkValues`+      (Empty+       :> Val "matches implicit construction" id "mjtu!pg!ufyu"+       :> Val "as sayable" (sez @"test") "CR41-3 'mjtu!pg!ufyu'"+       :> Val "as extracted text" nameText "mjtu!pg!ufyu"+      )++    it "CR42 CaseInsensitive conversion" $+      withChecklist "CR42" $+      (convertName (fromText "biT OF teXt" :: Named CaseInsensitive "CR42")+       :: Named CaseInsensitive "CR42 new")+      `checkValues`+      (Empty+       :> Val "matches implicit construction" id "bit of text"+       :> Val "as sayable" (sez @"test") "CR42 new «bit of text»"+       :> Val "as extracted text" nameText "bit of text"+      )++    it "CR43 Secure conversion" $+      withChecklist "CR43" $+      (convertName (fromText "hidden text" :: Named Secure "CR43")+       :: Named Secure "CR43 again")+      `checkValues`+      (Empty+       :> Val "matches implicit construction" id "hidden text"+       :> Val "as sayable" (sez @"test") "CR43 again 'hi#######xt'"+       :> Val "as extracted text" nameText "hi#######xt"+       :> Val "security bypass extraction" secureNameBypass ("hidden text" :: Text)+      )++  describe "Named style conversions" $ do+    -- n.b. these tests use the "instance ConvertNameStyle" below.++    it "CR44 UTF8->CaseInsensitive default conversion" $+      withChecklist "CR44" $+      (convertStyle (fromText "Some TEXT" :: Name "CR44")+        :: Named CaseInsensitive "CR44")+      `checkValues`+      (Empty+       :> Val "matches implicit construction" id "some text"+       :> Val "as sayable" (sez @"test") "CR44 «some text»"+       :> Val "as extracted text" nameText "some text"+      )++    it "CR45 UTF8->Secure default conversion" $+      withChecklist "CR45" $+      (convertStyle (fromText "Some TEXT" :: Name "CR45") :: Named Secure "CR45")+      `checkValues`+      (Empty+       :> Val "matches implicit construction" id "Some TEXT"+       :> Val "as sayable" (sez @"test") "CR45 'So#####XT'"+       :> Val "as extracted text" nameText "So#####XT"+      )++    it "CR46 CaseInsensitive->UTF8 default conversion" $+      withChecklist "CR46" $+      (convertStyle (fromText "Some TEXT" :: Named CaseInsensitive "CR46")+        :: Named UTF8 "CR46")+      `checkValues`+      (Empty+       :> Val "matches implicit construction" id "some text"+       :> Val "as sayable" (sez @"test") "CR46 'some text'"+       :> Val "as extracted text" nameText "some text"+      )++    it "CR47 Secure->UTF8 default conversion" $+      withChecklist "CR47" $+      (convertStyle (fromText "Some TEXT" :: Named Secure "CR47") :: Name "CR47")+      `checkValues`+      (Empty+       -- note here that the default only gets the masked form!+       :> Val "matches implicit construction" id "So#####XT"+       :> Val "as sayable" (sez @"test") "CR47 'So#####XT'"+       :> Val "as extracted text" nameText "So#####XT"+      )++    it "CR48 Secure->UTF8 implicit bypass conversion" $+      withChecklist "CR48" $+      (convertStyle (fromText "Some TEXT" :: Named Secure "CR48") :: Name "CR48")+      `checkValues`+      (Empty+       -- note here that the default only gets the masked form!+       :> Val "matches implicit construction" id "Some TEXT"+       :> Val "as sayable" (sez @"test") "CR48 'Some TEXT'"+       :> Val "as extracted text" nameText "Some TEXT"+      )++instance ConvertName UTF8 "CR40" "CR40-2"+instance ConvertName UTF8 "CR41" "CR41-3" where+  convertName = fromText . T.map succ . nameText+instance ConvertName CaseInsensitive "CR42" "CR42 new"+instance ConvertName Secure "CR43" "CR43 again" where+  convertName = fromText . secureNameBypass++instance ConvertNameStyle UTF8 CaseInsensitive "CR44"+instance ConvertNameStyle UTF8 Secure "CR45"+instance ConvertNameStyle CaseInsensitive UTF8 "CR46"+instance ConvertNameStyle Secure UTF8 "CR47"+instance ConvertNameStyle Secure UTF8 "CR48" where+  convertStyle = fromText . secureNameBypass+++testValidNames :: IO TestTree+testValidNames = testSpec "Named ValidNames" $+  describe "ValidNames" $ do+    -- n.b. Uses the validateName function below.++  it "CR50 Valid Names" $+    withChecklist "CR50" $+    (fromText "valid text" :: Name "CR50")+    `checkValues`+    (Empty+     :> Got "valid name for validateName call" validateName+     :> Val "validated text extraction"+      (validName (Proxy :: Proxy '[ "Foo", "CR50", "Other"])) "valid text"+    )++    -- It would be nice to test the failure case for ValidNames, but that's a+    -- compilation failure.++validateName :: ValidNames n '[ "CR50", "CR50.2" ] => Name n -> Bool+validateName = const True+++testSomeNames :: IO TestTree+testSomeNames = testSpec "Named SomeName and SomeStyle" $ do+  describe "SomeName" $ do++    it "CR60 SomeName collection and extraction" $+      withChecklist "CR60" $+      ([ SomeName (fromText "text one" :: Name "CR60.1")+       , SomeName (fromText "text two" :: Name "CR60 2")+       , SomeName (fromText "text 3" :: Name "CR60-three")+       ])+      `checkValues`+      (Empty+       :> Val "list length" length 3+       :> Val "@ 0" (viewSomeName (sez @"test") . (!!0)) "CR60.1 'text one'"+       :> Val "@ 1" (viewSomeName (sez @"test") . (!!1)) "CR60 2 'text two'"+       :> Val "@ 2" (viewSomeName (sez @"test") . (!!2)) "CR60-three 'text 3'"+      )++  describe "SomeStyle" $ do++    it "CR61 SomeStyle collection and extraction" $+      withChecklist "CR61" $+      ([ SomeNameStyle ("Regular text." :: Name "CR61")+       , SomeNameStyle ("cASE inSENsitIVE tEXt" :: Named CaseInsensitive "CR61")+       , SomeNameStyle ("secret text" :: Named Secure "CR61")+       ]+      )+      `checkValues`+      (Empty+       :> Val "list length" length 3+       :> Val "val @ 0" (viewSomeNameStyle nameText . (!!0)) "Regular text."+       :> Val "val @ 1" (viewSomeNameStyle nameText . (!!1)) "case insensitive text"+       :> Val "val @ 2" (viewSomeNameStyle nameText . (!!2)) "se#######xt"+       :> Val "nameOf @ 0" (viewSomeNameStyle (\n -> nameOf n proxy#) . (!!0)) "CR61"+       :> Val "nameOf @ 1" (viewSomeNameStyle (\n -> nameOf n proxy#) . (!!1)) "CR61"+       :> Val "nameOf @ 2" (viewSomeNameStyle (\n -> nameOf n proxy#) . (!!2)) "CR61"+      )++instance TestShow [SomeNameStyle "CR61"] where testShow = testShowList+instance TestShow (SomeNameStyle "CR61") where+  testShow = viewSomeNameStyle (\n -> nameOf n proxy# <> ": " <> show (nameText n))+++testHasName :: IO TestTree+testHasName = testSpec "HasName" $ do+  describe "HasName Foo" $ do++    it "CR70 can extract UTF8 myName from Foo" $+      myName (Foo "bar" "baz" "quux") `shouldBe` ("baz" :: Name "principle")++    it "CR71 can extract secure myName from Bar" $+      myName (Bar "baz" "quux") `shouldBe` ("quux" :: Named Secure "second")++data Foo = Foo (Name "prefix") (Name "principle") (Name "alt")+instance HasName Foo UTF8 "principle" where myName (Foo _ p _) = p++data Bar = Bar (Name "first") (Named Secure "second")+instance HasName Bar Secure "second" where myName (Bar _ s) = s+++testUtilities :: IO TestTree+testUtilities = testSpec "Named utilities" $ do+  describe "Named length" $ do++    it "CR80 can get a UTF8 length" $+      nameLength ("Length of TEXT" :: Name "CR80") `shouldBe` 14++    it "CR81 can get a CaseInsensitive length" $+      nameLength ("Length of TEXT" :: Named CaseInsensitive "CR81") `shouldBe` 14++    it "CR82 can get a Secure length" $+      nameLength ("Length of secure TEXT" :: Named Secure "CR82") `shouldBe` 21++  describe "Named null check" $ do++    it "CR83 can check a null UTF8" $+      nullName ("" :: Name "CR83") `shouldBe` True++    it "CR84 can check a non-null UTF8" $+      nullName ("Not empty" :: Name "CR84") `shouldBe` False++    it "CR85 can check a null CaseInsensitive named" $+      nullName ("" :: Named CaseInsensitive "CR85") `shouldBe` True++    it "CR86 can check a non-null CaseInsensitive named" $+      nullName ("Not empty" :: Named CaseInsensitive "CR86") `shouldBe` False++    it "CR87 can check a null Secure named" $+      nullName ("" :: Name "CR87") `shouldBe` True++    it "CR88 can check a non-null Secure named" $+      nullName ("Not empty" :: Named Secure "CR88") `shouldBe` False