named-text 1.2.4.0 → 1.2.5.0
raw patch · 5 files changed
+910/−15 lines, 5 files
Files
- CHANGELOG.md +26/−1
- Data/Name.hs +146/−13
- Data/Name/JSON.hs +5/−0
- named-text.cabal +1/−1
- test/Test.hs +732/−0
CHANGELOG.md view
@@ -1,6 +1,31 @@ # Revision history for named-text -## 1.2.4.0 -- 2026-07.04+## 1.2.5.0 -- 2026-08-23++* Added `NameUtilities` class, which defines the following methods:++ - `dropName`+ - `dropNameWhile`+ - `dropNameWhileEnd`+ - `takeName`+ - `breakName`+ - `breakOnName`+ - `isPrefixOfName`+ - `isSuffixOfName`+ - `isInfixOfName`+ - `unconsName`++ There are instances of the above (which function similarly to their `Data.Text`+ equivalents) for many--but not all--Name Styles. Notably there are no+ instances for `Secure` style names because that would allow leakage of the+ secure name, nor for `HTMLStyle` or `JSONStyle` names due to the risk of+ corrupted results due to the structured contents of those styles.+* Updated `CaseInsensitivePreserve` implementation internally to use `toCaseFold`+ instead of `toCaseLower` for various operations. This should have no impact+ but _may_ change the behavior of `Eq`, `Ord`, or `Hashable` operations.*+* Internal optimizations.++## 1.2.4.0 -- 2026-07-04 * Allow building with GHC 9.14.
Data/Name.hs view
@@ -159,9 +159,23 @@ -- * Utility operations , nameLength , nullName+ , NameUtilities+ , dropName+ , dropNameWhile+ , dropNameWhileEnd+ , takeName+ , breakName+ , breakOnName+ , isPrefixOfName+ , isSuffixOfName+ , isInfixOfName+ , unconsName ) where +import Control.Applicative ( (<|>) )+import Data.Bifunctor ( bimap )+import Data.Bool ( bool ) import Data.Function ( on ) import Data.Hashable ( Hashable, hash ) import Data.Proxy ( Proxy(Proxy) )@@ -310,17 +324,127 @@ ---------------------------------------------------------------------- -- Utility operations --- | Returns the length of the underlying 'Data.Text'+-- | _O(n)_ Returns the length of the underlying 'Data.Text' nameLength :: Named style nm -> Natural nameLength = toEnum . T.length . named --- | Returns true if the name value is empty.+-- | _O(1)_ Returns true if the name value is empty. nullName :: Named style nm -> Bool nullName = T.null . named +-- | Defines a class of various utility functions that will allow working with a+-- Name. This is defined as a class rather than discrete functions to allow each+-- class to refine these if necessary; in particular, the Secure style of Name+-- will disallow all of these because they could leak the Secure information. +class NameUtilities style nm where++ -- Note that the default instances here are carefully constructed in order to+ -- use the Eq functionality of the corresponding Name, rather than relying+ -- solely on Text Eq instances. Thus, they frequently use a more detailed+ -- algorithm than simply calling the corresponding Data.Text operation on the+ -- Name's contents.++ -- | _O(n)_ Drops the specified number of characters from the front of the+ -- name. If more characters are dropped than exist in the name, the resulting+ -- name is a null Name.+ dropName :: Natural -> Named style nm -> Named style nm+ dropName cnt = Named . T.drop (fromEnum cnt) . named++ -- | _O(n)_ Takes the specified number of characters from the front of the+ -- name. If more characters are requested than exist in the name, the original+ -- name is returned.+ takeName :: Natural -> Named style nm -> Named style nm+ takeName cnt = Named . T.take (fromEnum cnt) . named++ -- | _O(n)_ Drops the start of the Name while the specified condition holds+ -- true. Be aware that when using some styles like CaseInsensitivePreserved,+ -- the supplied predicate is responsible for preserving the desired behavior.+ dropNameWhile :: (Char -> Bool) -> Named style nm -> Named style nm+ dropNameWhile p = Named . T.dropWhile p . named++ -- | _O(n)_ Drops the end of the Name while the specified condition holds True.+ -- Be aware that when using some styles like CaseInsensitivePreserved, the+ -- supplied predicate is responsible for preserving the desired behavior.+ dropNameWhileEnd :: (Char -> Bool) -> Named style nm -> Named style nm+ dropNameWhileEnd p = Named . T.dropWhileEnd p . named++ -- | _O(n)_ Returns a pair whose first element is the portion of the Name for+ -- which the supplied predicate returned False, and the second element is the+ -- remaining portion of the input Name. Be aware that when using some styles+ -- like CaseInsensitivePreserved, the supplied predicate is responsible for+ -- preserving the desired behavior.+ breakName :: (Char -> Bool) -> Named style nm+ -> ( Named style nm, Named style nm )+ breakName p = bimap Named Named . T.break p . named++ -- | _O(n+m)_ Finds the first instance of the first Name in the second Name and+ -- returns a tuple that splits the second name at the place where the first+ -- Name was found (thus the second element will start with the first Name).+ --+ -- If the first Name does not exist in the second Name, the second element of+ -- the tuple will be a null Name.+ --+ -- If the first name is a null Name, it will never be found in the second Name+ -- and the result will be a "not found" (the return tuple's first element will+ -- be the second input, and the second element will be a null name). This+ -- behavior is different than the Data.Text.breakOn, which will throw an error+ -- exception if the first input is null.+ breakOnName :: Eq (Named style nm)+ => Named style nm -> Named style nm+ -> (Named style nm, Named style nm)+ breakOnName what full =+ let whatL = nameLength what+ fullL = nameLength full+ checkAt n =+ let r = dropName n full+ in (<|> (bool Nothing (Just (takeName n full, r))+ $ what == takeName whatL r+ ))++ in case T.compareLength (named what) (fromEnum fullL) of+ GT -> (full, Named "")+ EQ -> bool (full, "") ("", full) $ what == full+ LT -> maybe (full, "") id $ foldr checkAt Nothing [0 .. fullL - whatL]++ -- | _O(n)_ Returns true if the first name is a prefix of the second.+ isPrefixOfName :: Eq (Named style nm)+ => Named style nm -> Named style nm -> Bool+ isPrefixOfName pfx full =+ pfx == (Named $ T.take (fromEnum $ nameLength pfx) $ named full)++ -- | _O(n)_ Returns true if the first name is a suffix of the second.+ isSuffixOfName :: Eq (Named style nm)+ => Named style nm -> Named style nm -> Bool+ isSuffixOfName sfx full =+ let fL = nameLength full+ sL = nameLength sfx+ in case T.compareLength (named sfx) (fromEnum fL) of+ GT -> False -- suffix is longer than target name+ _ -> sfx == (Named $ T.drop (fromEnum $ fL - sL) $ named full)++ -- | _O(n)_ Returns true if the first name is contained in the second.+ isInfixOfName :: Eq (Named style nm)+ => Named style nm -> Named style nm -> Bool+ isInfixOfName ifx full =+ let fL = nameLength full+ ifL = nameLength ifx+ checkAt x = flip bool True+ $ ifx == (takeName ifL $ dropName x full)+ in case T.compareLength (named ifx) (fromEnum fL) of+ GT -> False -- infix is longer than target name+ _ -> foldr checkAt False [0 .. fL - ifL ]++ -- | _O(1)_ Returns nothing if the input Name is null, otherwise returns the+ -- first character of the Name and the remaining Name. Note that the+ -- style-appropriate handling of the returned character is the responsibility+ -- of the caller.+ unconsName :: Named style nm -> Maybe (Char, Named style nm)+ unconsName = fmap (fmap Named) . T.uncons . named++ ---------------------------------------------------------------------- -- | The 'SomeName' data type is used to existentially hide the identification@@ -387,7 +511,9 @@ deriving instance Ord (Named UTF8 nameOf) deriving instance Hashable (Named UTF8 nameOf) +instance NameUtilities UTF8 nm + ---------------------------------------------------------------------- -- * CaseInsensitive Named objects @@ -427,6 +553,8 @@ deriving instance Ord (Named CaseInsensitive nameOf) deriving instance Hashable (Named CaseInsensitive nameOf) +instance NameUtilities CaseInsensitive nm+ ---------------------------------------------------------------------- -- * CaseInsensitivePreserve Named objects @@ -461,14 +589,15 @@ -- CaseInsensitivePreserve because this cannot be round-tripped. instance Eq (Named CaseInsensitivePreserve nameOf) where- (==) = (==) `on` (T.toLower . nameText)+ (==) = (==) `on` (T.toCaseFold . nameText) instance Ord (Named CaseInsensitivePreserve nameOf) where- compare = compare `on` (T.toLower . nameText)+ compare = compare `on` (T.toCaseFold . nameText) instance Hashable (Named CaseInsensitivePreserve nameOf) where- hash = hash . T.toLower . nameText+ hash = hash . T.toCaseFold . nameText +instance NameUtilities CaseInsensitivePreserve nm ---------------------------------------------------------------------- -- * Secure Named objects@@ -493,11 +622,12 @@ -- be used 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))+secureName nm =+ case T.compareLength (named nm) 5 of+ LT -> T.replicate 8 "#"+ _ -> ((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@@ -520,7 +650,10 @@ deriving instance Ord (Named Secure nameOf) deriving instance Hashable (Named Secure nameOf) +-- n.b. do NOT define and instance of NameUtilites for the Secure style because+-- it would leak secure information. + ---------------------------------------------------------------------- -- * HTML Names @@ -587,9 +720,9 @@ deriving instance Ord (Named HTMLStyle nameOf) deriving instance Hashable (Named HTMLStyle nameOf) --- Trigger faults in the code and trace them for impact---- GA has no MB experience, so don't know how much to expect or have any expectations. Fault triggering and detection would be the principle focus.+-- Note, NameUtilites are not defined because it is possible that they might+-- result in invalid HTML (splitting/dropping/taking partial tags or escaped+-- characters). ---------------------------------------------------------------------- -- Constraining allowed names
Data/Name/JSON.hs view
@@ -45,6 +45,11 @@ deriving instance Ord (Named JSONStyle nameOf) deriving instance Hashable (Named JSONStyle nameOf) +-- However, since a JSON entity is structured, it is highly unlikely that the+-- NameUtilities operations will be valid (especially since JSON is whitespace-+-- and mostly order- insensitive and therefore may have multiple+-- representations), so NameUtilities are NOT defined for JSONStyle.+ instance ConvertNameStyle JSONStyle UTF8 nameOf instance ConvertNameStyle UTF8 JSONStyle nameOf
named-text.cabal view
@@ -1,6 +1,6 @@ cabal-version: 2.4 name: named-text-version: 1.2.4.0+version: 1.2.5.0 synopsis: A parameterized named text type and associated functionality. description: .
test/Test.hs view
@@ -661,6 +661,738 @@ it "CR88 can check a non-null Secure named" $ nullName ("Not empty" :: Named Secure "CR88") `shouldBe` False + describe "Name prefix check" $ do++ it "CR110 can check a null prefix of a null UTF8" $+ (("" :: Name "CR110") `isPrefixOfName` ("" :: Name "CR110")) `shouldBe` True++ it "CR111 can check a null prefix UTF8" $+ (("" :: Name "CR111") `isPrefixOfName` ("stuff" :: Name "CR111"))+ `shouldBe` True++ it "CR112 can check a valid prefix UTF8" $+ (("st" :: Name "CR112") `isPrefixOfName` ("stuff" :: Name "CR112"))+ `shouldBe` True++ it "CR113 can check a long multi-word prefix UTF8" $+ (("This is a\n\t prefix" :: Name "CR113")+ `isPrefixOfName`+ ("This is a\n\t prefix!" :: Name "CR113")) `shouldBe` True++ it "CR114 rejects an invalid prefix UTF8" $+ (("bad" :: Name "CR114") `isPrefixOfName` ("stuff" :: Name "CR114"))+ `shouldBe` False++ it "CR115 rejects an too-long prefix UTF8" $+ (("stuffing" :: Name "CR115") `isPrefixOfName` ("stuff" :: Name "CR115"))+ `shouldBe` False++ it "CR116 rejects an case mismatch UTF8" $+ (("STUFF" :: Name "CR116") `isPrefixOfName` ("stuff" :: Name "CR116"))+ `shouldBe` False++ -----------------------------++ it "CR120 can check a null prefix of a null CaseInsensitive" $+ (("" :: Named CaseInsensitive "CR120")+ `isPrefixOfName`+ ("" :: Named CaseInsensitive "CR120")) `shouldBe` True++ it "CR121 can check a null prefix CaseInsensitive" $+ (("" :: Named CaseInsensitive "CR121")+ `isPrefixOfName`+ ("stuff" :: Named CaseInsensitive "CR121"))+ `shouldBe` True++ it "CR122 can check a valid prefix CaseInsensitive" $+ (("sT" :: Named CaseInsensitive "CR122")+ `isPrefixOfName`+ ("Stuff" :: Named CaseInsensitive "CR122"))+ `shouldBe` True++ it "CR123 can check a long multi-word prefix CaseInsensitive" $+ (("This is A\n\t prefix" :: Named CaseInsensitive "CR123")+ `isPrefixOfName`+ ("This is a\n\t Prefix!" :: Named CaseInsensitive "CR123"))+ `shouldBe` True++ it "CR124 rejects an invalid prefix CaseInsensitive" $+ (("bad" :: Named CaseInsensitive "CR124")+ `isPrefixOfName`+ ("stuff" :: Named CaseInsensitive "CR124"))+ `shouldBe` False++ it "CR125 rejects an too-long prefix CaseInsensitive" $+ (("stuffing" :: Named CaseInsensitive "CR125")+ `isPrefixOfName` ("stuff" :: Named CaseInsensitive "CR125"))+ `shouldBe` False++ it "CR126 accepts a case mismatch UTF8" $+ (("STUFF" :: Named CaseInsensitive "CR126")+ `isPrefixOfName`+ ("stuff" :: Named CaseInsensitive "CR126"))+ `shouldBe` True++ -----------------------------++ it "CR130 can check a null prefix of a null CaseInsensitivePreserve" $+ (("" :: Named CaseInsensitivePreserve "CR130")+ `isPrefixOfName`+ ("" :: Named CaseInsensitivePreserve "CR130")) `shouldBe` True++ it "CR131 can check a null prefix CaseInsensitivePreserve" $+ (("" :: Named CaseInsensitivePreserve "CR131")+ `isPrefixOfName`+ ("stuff" :: Named CaseInsensitivePreserve "CR131"))+ `shouldBe` True++ it "CR132 can check a valid prefix CaseInsensitivePreserve" $+ (("sT" :: Named CaseInsensitivePreserve "CR132")+ `isPrefixOfName`+ ("Stuff" :: Named CaseInsensitivePreserve "CR132"))+ `shouldBe` True++ it "CR133 can check a long multi-word prefix CaseInsensitivePreserve" $+ (("This is A\n\t prefix" :: Named CaseInsensitivePreserve "CR133")+ `isPrefixOfName`+ ("This is a\n\t Prefix!" :: Named CaseInsensitivePreserve "CR133"))+ `shouldBe` True++ it "CR134 rejects an invalid prefix CaseInsensitivePreserve" $+ (("bad" :: Named CaseInsensitivePreserve "CR134")+ `isPrefixOfName`+ ("stuff" :: Named CaseInsensitivePreserve "CR134"))+ `shouldBe` False++ it "CR135 rejects an too-long prefix CaseInsensitivePreserve" $+ (("stuffing" :: Named CaseInsensitivePreserve "CR135")+ `isPrefixOfName` ("stuff" :: Named CaseInsensitivePreserve "CR135"))+ `shouldBe` False++ it "CR136 accepts a case mismatch UTF8" $+ (("STUFF" :: Named CaseInsensitivePreserve "CR136")+ `isPrefixOfName`+ ("stuff" :: Named CaseInsensitivePreserve "CR136"))+ `shouldBe` True++ -----------------------------+ -- n.b. These would cause a type error because NameUtilities are not defined+ -- for Secure.++ -- it "CR140 can check a null prefix of a null Secure" $+ -- (("" :: Named Secure "CR140")+ -- `isPrefixOfName`+ -- ("" :: Named Secure "CR140")) `shouldBe` True++ -----------------------------+ -- n.b. These would cause a type error because NameUtilities are not defined+ -- for HTMLStyle.++ -- it "CR150 can check a null prefix of a null HTMLStyle" $+ -- (("" :: Named HTMLStyle "CR150")+ -- `isPrefixOfName`+ -- ("" :: Named HTMLStyle "CR150")) `shouldBe` True++ describe "Name suffix check" $ do++ it "CR210 can check a null suffix of a null UTF8" $+ (("" :: Name "CR210") `isSuffixOfName` ("" :: Name "CR210")) `shouldBe` True++ it "CR211 can check a null suffix UTF8" $+ (("" :: Name "CR211") `isSuffixOfName` ("stuff" :: Name "CR211"))+ `shouldBe` True++ it "CR212 can check a valid suffix UTF8" $+ (("uff" :: Name "CR212") `isSuffixOfName` ("stuff" :: Name "CR212"))+ `shouldBe` True++ it "CR213 can check a long multi-word suffix UTF8" $+ (("!" :: Name "CR213")+ `isSuffixOfName`+ ("This is a\n\t suffix!" :: Name "CR213")) `shouldBe` True++ it "CR214 rejects an invalid suffix UTF8" $+ (("bad" :: Name "CR214") `isSuffixOfName` ("stuff" :: Name "CR214"))+ `shouldBe` False++ it "CR215 rejects an too-long suffix UTF8" $+ (("stuffing" :: Name "CR215") `isSuffixOfName` ("stuff" :: Name "CR215"))+ `shouldBe` False++ it "CR216 rejects an case mismatch UTF8" $+ (("STUFF" :: Name "CR216") `isSuffixOfName` ("stuff" :: Name "CR216"))+ `shouldBe` False++ -----------------------------++ it "CR220 can check a null suffix of a null CaseInsensitive" $+ (("" :: Named CaseInsensitive "CR220")+ `isSuffixOfName`+ ("" :: Named CaseInsensitive "CR220")) `shouldBe` True++ it "CR221 can check a null suffix CaseInsensitive" $+ (("" :: Named CaseInsensitive "CR221")+ `isSuffixOfName`+ ("stuff" :: Named CaseInsensitive "CR221"))+ `shouldBe` True++ it "CR222 can check a valid suffix CaseInsensitive" $+ (("Uff" :: Named CaseInsensitive "CR222")+ `isSuffixOfName`+ ("Stuff" :: Named CaseInsensitive "CR222"))+ `shouldBe` True++ it "CR223 can check a long multi-word suffix CaseInsensitive" $+ (("This is A\n\t suffix!" :: Named CaseInsensitive "CR223")+ `isSuffixOfName`+ ("This is a\n\t Suffix!" :: Named CaseInsensitive "CR223"))+ `shouldBe` True++ it "CR224 rejects an invalid suffix CaseInsensitive" $+ (("bad" :: Named CaseInsensitive "CR224")+ `isSuffixOfName`+ ("stuff" :: Named CaseInsensitive "CR224"))+ `shouldBe` False++ it "CR225 rejects an too-long suffix CaseInsensitive" $+ (("stuffing" :: Named CaseInsensitive "CR225")+ `isSuffixOfName` ("stuff" :: Named CaseInsensitive "CR225"))+ `shouldBe` False++ it "CR226 accepts a case mismatch UTF8" $+ (("STUFF" :: Named CaseInsensitive "CR226")+ `isSuffixOfName`+ ("stuff" :: Named CaseInsensitive "CR226"))+ `shouldBe` True++ -----------------------------++ it "CR230 can check a null suffix of a null CaseInsensitivePreserve" $+ (("" :: Named CaseInsensitivePreserve "CR230")+ `isSuffixOfName`+ ("" :: Named CaseInsensitivePreserve "CR230")) `shouldBe` True++ it "CR231 can check a null suffix CaseInsensitivePreserve" $+ (("" :: Named CaseInsensitivePreserve "CR231")+ `isSuffixOfName`+ ("stuff" :: Named CaseInsensitivePreserve "CR231"))+ `shouldBe` True++ it "CR232 can check a valid suffix CaseInsensitivePreserve" $+ (("uFf" :: Named CaseInsensitivePreserve "CR232")+ `isSuffixOfName`+ ("Stuff" :: Named CaseInsensitivePreserve "CR232"))+ `shouldBe` True++ it "CR233 can check a long multi-word suffix CaseInsensitivePreserve" $+ ((" A\n\t suffix!" :: Named CaseInsensitivePreserve "CR233")+ `isSuffixOfName`+ ("This is a\n\t Suffix!" :: Named CaseInsensitivePreserve "CR233"))+ `shouldBe` True++ it "CR234 rejects an invalid suffix CaseInsensitivePreserve" $+ (("bad" :: Named CaseInsensitivePreserve "CR234")+ `isSuffixOfName`+ ("stuff" :: Named CaseInsensitivePreserve "CR234"))+ `shouldBe` False++ it "CR235 rejects an too-long suffix CaseInsensitivePreserve" $+ (("stuffing" :: Named CaseInsensitivePreserve "CR235")+ `isSuffixOfName` ("stuff" :: Named CaseInsensitivePreserve "CR235"))+ `shouldBe` False++ it "CR236 accepts a case mismatch UTF8" $+ (("STUFF" :: Named CaseInsensitivePreserve "CR236")+ `isSuffixOfName`+ ("stuff" :: Named CaseInsensitivePreserve "CR236"))+ `shouldBe` True++ -----------------------------+ -- n.b. These would cause a type error because NameUtilities are not defined+ -- for Secure.++ -- it "CR240 can check a null suffix of a null Secure" $+ -- (("" :: Named Secure "CR240")+ -- `isSuffixOfName`+ -- ("" :: Named Secure "CR240")) `shouldBe` True++ -----------------------------+ -- n.b. These would cause a type error because NameUtilities are not defined+ -- for HTMLStyle.++ -- it "CR250 can check a null suffix of a null HTMLStyle" $+ -- (("" :: Named HTMLStyle "CR250")+ -- `isSuffixOfName`+ -- ("" :: Named HTMLStyle "CR250")) `shouldBe` True++ describe "Name infix check" $ do++ it "CR310 can check a null infix of a null UTF8" $+ (("" :: Name "CR310") `isInfixOfName` ("" :: Name "CR310")) `shouldBe` True++ it "CR311 can check a null infix UTF8" $+ (("" :: Name "CR311") `isInfixOfName` ("stuff" :: Name "CR311"))+ `shouldBe` True++ it "CR312 can check a valid ending infix UTF8" $+ (("uff" :: Name "CR312") `isInfixOfName` ("stuff" :: Name "CR312"))+ `shouldBe` True++ it "CR313 can check a long multi-word infix UTF8" $+ (("!" :: Name "CR313")+ `isInfixOfName`+ ("This is a\n\t infix!" :: Name "CR313")) `shouldBe` True++ it "CR314 rejects an invalid infix UTF8" $+ (("bad" :: Name "CR314") `isInfixOfName` ("stuff" :: Name "CR314"))+ `shouldBe` False++ it "CR315 rejects an too-long infix UTF8" $+ (("stuffing" :: Name "CR315") `isInfixOfName` ("stuff" :: Name "CR315"))+ `shouldBe` False++ it "CR316 rejects an case mismatch UTF8" $+ (("STUFF" :: Name "CR316") `isInfixOfName` ("stuff" :: Name "CR316"))+ `shouldBe` False++ it "CR317 can check a valid internal infix UTF8" $+ (("tuf" :: Name "CR312") `isInfixOfName` ("stuff" :: Name "CR312"))+ `shouldBe` True++ it "CR318 can check a valid starting infix UTF8" $+ (("st" :: Name "CR318") `isInfixOfName` ("stuff" :: Name "CR318"))+ `shouldBe` True++ it "CR319 can check a valid equality is an infix UTF8" $+ (("stuff" :: Name "CR319") `isInfixOfName` ("stuff" :: Name "CR319"))+ `shouldBe` True++ -----------------------------++ it "CR320 can check a null infix of a null CaseInsensitive" $+ (("" :: Named CaseInsensitive "CR320")+ `isInfixOfName`+ ("" :: Named CaseInsensitive "CR320")) `shouldBe` True++ it "CR321 can check a null infix CaseInsensitive" $+ (("" :: Named CaseInsensitive "CR321")+ `isInfixOfName`+ ("stuff" :: Named CaseInsensitive "CR321"))+ `shouldBe` True++ it "CR322 can check a valid infix CaseInsensitive" $+ (("Uff" :: Named CaseInsensitive "CR322")+ `isInfixOfName`+ ("Stuff" :: Named CaseInsensitive "CR322"))+ `shouldBe` True++ it "CR323 can check a long multi-word infix CaseInsensitive" $+ (("s A\n\t i" :: Named CaseInsensitive "CR323")+ `isInfixOfName`+ ("This is a\n\t Infix!" :: Named CaseInsensitive "CR323"))+ `shouldBe` True++ it "CR324 rejects an invalid infix CaseInsensitive" $+ (("bad" :: Named CaseInsensitive "CR324")+ `isInfixOfName`+ ("stuff" :: Named CaseInsensitive "CR324"))+ `shouldBe` False++ it "CR325 rejects an too-long infix CaseInsensitive" $+ (("stuffing" :: Named CaseInsensitive "CR325")+ `isInfixOfName` ("stuff" :: Named CaseInsensitive "CR325"))+ `shouldBe` False++ it "CR326 accepts a case mismatch UTF8" $+ (("STUFF" :: Named CaseInsensitive "CR326")+ `isInfixOfName`+ ("stuff" :: Named CaseInsensitive "CR326"))+ `shouldBe` True++ -----------------------------++ it "CR330 can check a null infix of a null CaseInsensitivePreserve" $+ (("" :: Named CaseInsensitivePreserve "CR330")+ `isInfixOfName`+ ("" :: Named CaseInsensitivePreserve "CR330")) `shouldBe` True++ it "CR331 can check a null infix CaseInsensitivePreserve" $+ (("" :: Named CaseInsensitivePreserve "CR331")+ `isInfixOfName`+ ("stuff" :: Named CaseInsensitivePreserve "CR331"))+ `shouldBe` True++ it "CR332 can check a valid infix CaseInsensitivePreserve" $+ (("uFf" :: Named CaseInsensitivePreserve "CR332")+ `isInfixOfName`+ ("Stuff" :: Named CaseInsensitivePreserve "CR332"))+ `shouldBe` True++ it "CR333 can check a long multi-word infix CaseInsensitivePreserve" $+ ((" A\n\t inf" :: Named CaseInsensitivePreserve "CR333")+ `isInfixOfName`+ ("This is a\n\t Infix!" :: Named CaseInsensitivePreserve "CR333"))+ `shouldBe` True++ it "CR334 rejects an invalid infix CaseInsensitivePreserve" $+ (("bad" :: Named CaseInsensitivePreserve "CR334")+ `isInfixOfName`+ ("stuff" :: Named CaseInsensitivePreserve "CR334"))+ `shouldBe` False++ it "CR335 rejects an too-long infix CaseInsensitivePreserve" $+ (("stuffing" :: Named CaseInsensitivePreserve "CR335")+ `isInfixOfName` ("stuff" :: Named CaseInsensitivePreserve "CR335"))+ `shouldBe` False++ it "CR336 accepts a case mismatch UTF8" $+ (("STUFF" :: Named CaseInsensitivePreserve "CR336")+ `isInfixOfName`+ ("stuff" :: Named CaseInsensitivePreserve "CR336"))+ `shouldBe` True++ -----------------------------+ -- n.b. These would cause a type error because NameUtilities are not defined+ -- for Secure..++ -- it "CR340 can check a null infix of a null Secure" $+ -- (("" :: Named Secure "CR340")+ -- `isInfixOfName`+ -- ("" :: Named Secure "CR340")) `shouldBe` True+++ -----------------------------+ -- n.b. These would cause a type error because NameUtilities are not defined+ -- for HTMLStyle.++ -- it "CR350 can check a null infix of a null HTMLStyle" $+ -- (("" :: Named HTMLStyle "CR350")+ -- `isInfixOfName`+ -- ("" :: Named HTMLStyle "CR350")) `shouldBe` True++ describe "Name take and drop" $ do++ let sampleInp = "take and drop" :: Name "t&d"++ it "CR360 can take nothing" $ do+ takeName 0 sampleInp `shouldBe` fromText ""++ it "CR361 can take everything" $ do+ takeName (nameLength sampleInp) sampleInp `shouldBe` sampleInp++ it "CR362 can take some" $ do+ takeName 3 sampleInp `shouldBe` "tak"++ it "CR370 can drop nothing" $ do+ dropName 0 sampleInp `shouldBe` sampleInp++ it "CR371 can drop everything" $ do+ dropName (nameLength sampleInp) sampleInp `shouldBe` fromText ""++ it "CR372 can drop some" $ do+ dropName 3 sampleInp `shouldBe` fromText "e and drop"++ it "CR373 can drop while nothing" $ do+ dropNameWhile (const False) sampleInp `shouldBe` sampleInp++ it "CR374 can drop while everything" $ do+ dropNameWhile (const True) sampleInp `shouldBe` ""++ it "CR375 can drop while some" $ do+ dropNameWhile (/= ' ') sampleInp `shouldBe` fromText " and drop"++ it "CR376 can drop while end nothing" $ do+ dropNameWhileEnd (const False) sampleInp `shouldBe` sampleInp++ it "CR377 can drop while end everything" $ do+ dropNameWhileEnd (const True) sampleInp `shouldBe` ""++ it "CR378 can drop while end some" $ do+ dropNameWhileEnd (/= ' ') sampleInp `shouldBe` fromText "take and "++ --------------------++ let sAmPLeInp = "TaKe aNd drOp" :: Named CaseInsensitive "t&d"++ it "CR380 can take nothing" $ do+ takeName 0 sAmPLeInp `shouldBe` fromText ""++ it "CR381 can take everything" $ do+ takeName (nameLength sAmPLeInp) sAmPLeInp `shouldBe` sAmPLeInp++ it "CR382 can take some" $ do+ takeName 3 sAmPLeInp `shouldBe` "taK"++ it "CR390 can drop nothing" $ do+ dropName 0 sAmPLeInp `shouldBe` sAmPLeInp++ it "CR391 can drop everything" $ do+ dropName (nameLength sAmPLeInp) sAmPLeInp `shouldBe` fromText ""++ it "CR392 can drop some" $ do+ dropName 3 sAmPLeInp `shouldBe` fromText "e AND DROP"++ it "CR393 can drop while nothing" $ do+ dropNameWhile (const False) sAmPLeInp `shouldBe` sAmPLeInp++ it "CR394 can drop while everything" $ do+ dropNameWhile (const True) sAmPLeInp `shouldBe` ""++ it "CR395 can drop while some" $ do+ dropNameWhile (/= ' ') sAmPLeInp `shouldBe` fromText " AND drop"++ it "CR396 can drop while end nothing" $ do+ dropNameWhileEnd (const False) sAmPLeInp `shouldBe` sAmPLeInp++ it "CR397 can drop while end everything" $ do+ dropNameWhileEnd (const True) sAmPLeInp `shouldBe` ""++ it "CR398 can drop while end some" $ do+ dropNameWhileEnd (/= ' ') sAmPLeInp `shouldBe` fromText "Take AND "++ --------------------++ let sAMPLEInp = "TaKe aNd drOp" :: Named CaseInsensitivePreserve "t&d"++ it "CR400 can take nothing" $ do+ takeName 0 sAMPLEInp `shouldBe` fromText ""++ it "CR401 can take everything" $ do+ takeName (nameLength sAMPLEInp) sAMPLEInp `shouldBe` sAMPLEInp++ it "CR402 can take some" $ do+ takeName 3 sAMPLEInp `shouldBe` "taK"++ it "CR403 can drop nothing" $ do+ dropName 0 sAMPLEInp `shouldBe` sAMPLEInp++ it "CR404 can drop everything" $ do+ dropName (nameLength sAMPLEInp) sAMPLEInp `shouldBe` fromText ""++ it "CR405 can drop some" $ do+ dropName 3 sAMPLEInp `shouldBe` fromText "e AND DROP"++ it "CR406 can drop while nothing" $ do+ dropNameWhile (const False) sAMPLEInp `shouldBe` sAMPLEInp++ it "CR407 can drop while everything" $ do+ dropNameWhile (const True) sAMPLEInp `shouldBe` ""++ it "CR408 can drop while some" $ do+ dropNameWhile (/= ' ') sAMPLEInp `shouldBe` fromText " AND drop"++ it "CR409 can drop while end nothing" $ do+ dropNameWhileEnd (const False) sAMPLEInp `shouldBe` sAMPLEInp++ it "CR409a can drop while end everything" $ do+ dropNameWhileEnd (const True) sAMPLEInp `shouldBe` ""++ it "CR409b can drop while end some" $ do+ dropNameWhileEnd (/= ' ') sAMPLEInp `shouldBe` fromText "Take AND "++ --------------------+ -- n.b. These would cause a type error because NameUtilities are not+ -- supported for Secure because that would leak the Secure name:++ -- it "CR363 cannot take from secure" $ do+ -- takeName 0 ("hidden" :: Named Secure "CR363")+ -- `shouldBe`+ -- ("disallowed" :: Named Secure "CR363")++ -- it "CR373 can drop from secure" $ do+ -- dropName 0 ("hidden" :: Named Secure "CR363")+ -- `shouldBe`+ -- ("disallowed" :: Named Secure "CR363")++ describe "Name breaking check" $ do++ it "CR410 can check a null breakOn of a null UTF8" $+ (("" :: Name "CR410") `breakOnName` ("" :: Name "CR410"))+ `shouldBe` ("", "")++ it "CR411 can check a null infix UTF8" $+ (("" :: Name "CR411") `breakOnName` ("stuff" :: Name "CR411"))+ `shouldBe` ("stuff", "")++ it "CR412 can check a valid ending infix UTF8" $+ (("uff" :: Name "CR412") `breakOnName` ("stuff" :: Name "CR412"))+ `shouldBe` ("st", "uff")++ it "CR413 can check a long multi-word infix UTF8" $+ (("!" :: Name "CR413")+ `breakOnName`+ ("This is a\n\t infix!" :: Name "CR413"))+ `shouldBe`+ ("This is a\n\t infix", "!")++ it "CR414 rejects an invalid infix UTF8" $+ (("bad" :: Name "CR414") `breakOnName` ("stuff" :: Name "CR414"))+ `shouldBe`+ ("stuff", "")++ it "CR415 rejects an too-long infix UTF8" $+ (("stuffing" :: Name "CR415") `breakOnName` ("stuff" :: Name "CR415"))+ `shouldBe`+ ("stuff", "")++ it "CR416 rejects an case mismatch UTF8" $+ (("STUFF" :: Name "CR416") `breakOnName` ("stuff" :: Name "CR416"))+ `shouldBe`+ ("stuff", "")++ it "CR417 can check a valid internal infix UTF8" $+ (("tuf" :: Name "CR412") `breakOnName` ("stuff" :: Name "CR412"))+ `shouldBe`+ ("s", "tuff")++ it "CR418 can check a valid starting infix UTF8" $+ (("st" :: Name "CR418") `breakOnName` ("stuff" :: Name "CR418"))+ `shouldBe`+ ("", "stuff")++ it "CR419 can check a valid equality is an infix UTF8" $+ (("stuff" :: Name "CR419") `breakOnName` ("stuff" :: Name "CR419"))+ `shouldBe`+ ("", "stuff")++ it "CR419a can break nothing" $ do+ breakName (const False) ("some stuff" :: Name "CR419a")+ `shouldBe`+ ("some stuff" :: Name "CR419a", "")++ it "CR419b can break everything" $ do+ breakName (const True) ("some stuff" :: Name "CR419b")+ `shouldBe` ("", "some stuff")++ it "CR419c can break some" $ do+ breakName (== ' ') ("some stuff" :: Name "CR419b")+ `shouldBe` (fromText "some", " stuff")++ --------------------++ it "CR420 can check a null breakOn of a null CaseInsensitive" $+ (("" :: Named CaseInsensitive "CR420")+ `breakOnName`+ ("" :: Named CaseInsensitive "CR420"))+ `shouldBe` ("", "")++ it "CR421 can check a null infix CaseInsensitive" $+ (("" :: Named CaseInsensitive "CR421")+ `breakOnName`+ ("stuff" :: Named CaseInsensitive "CR421"))+ `shouldBe` ("stuff", "")++ it "CR422 can check a valid ending infix CaseInsensitive" $+ (("Uff" :: Named CaseInsensitive "CR422")+ `breakOnName`+ ("Stuff" :: Named CaseInsensitive "CR422"))+ `shouldBe` ("st", "uff")++ it "CR423 can check a long multi-word infix CaseInsensitive" $+ (("!" :: Named CaseInsensitive "CR423")+ `breakOnName`+ ("This is A\n\t infix!" :: Named CaseInsensitive "CR423"))+ `shouldBe`+ ("This is a\n\t INFIX", "!")++ it "CR424 rejects an invalid infix CaseInsensitive" $+ (("bad" :: Named CaseInsensitive "CR424")+ `breakOnName`+ ("stuff" :: Named CaseInsensitive "CR424"))+ `shouldBe`+ ("stuff", "")++ it "CR425 rejects an too-long infix CaseInsensitive" $+ (("stuffing" :: Named CaseInsensitive "CR425")+ `breakOnName`+ ("stuff" :: Named CaseInsensitive "CR425"))+ `shouldBe`+ ("stuff", "")++ it "CR426 accepts a case mismatch CaseInsensitive" $+ (("STUFF" :: Named CaseInsensitive "CR426")+ `breakOnName`+ ("stuff" :: Named CaseInsensitive "CR426"))+ `shouldBe`+ ("", "stuff")++ it "CR427 can check a valid internal infix CaseInsensitive" $+ (("tUf" :: Named CaseInsensitive "CR422")+ `breakOnName`+ ("STUFf" :: Named CaseInsensitive "CR422"))+ `shouldBe`+ ("s", "Tuff")++ it "CR428 can check a valid starting infix CaseInsensitive" $+ (("st" :: Named CaseInsensitive "CR428")+ `breakOnName`+ ("STUFF" :: Named CaseInsensitive "CR428"))+ `shouldBe`+ ("", "stUFf")++ --------------------++ it "CR430 can check a null breakOn of a null CaseInsensitivePreserve" $+ (("" :: Named CaseInsensitivePreserve "CR430")+ `breakOnName`+ ("" :: Named CaseInsensitivePreserve "CR430"))+ `shouldBe` ("", "")++ it "CR431 can check a null infix CaseInsensitivePreserve" $+ (("" :: Named CaseInsensitivePreserve "CR431")+ `breakOnName`+ ("stuff" :: Named CaseInsensitivePreserve "CR431"))+ `shouldBe` ("stuff", "")++ it "CR432 can check a valid ending infix CaseInsensitivePreserve" $+ (("Uff" :: Named CaseInsensitivePreserve "CR432")+ `breakOnName`+ ("Stuff" :: Named CaseInsensitivePreserve "CR432"))+ `shouldBe` ("st", "uff")++ it "CR433 can check a long multi-word infix CaseInsensitivePreserve" $+ (("!" :: Named CaseInsensitivePreserve "CR433")+ `breakOnName`+ ("This is A\n\t infix!" :: Named CaseInsensitivePreserve "CR433"))+ `shouldBe`+ ("This is a\n\t INFIX", "!")++ it "CR434 rejects an invalid infix CaseInsensitivePreserve" $+ (("bad" :: Named CaseInsensitivePreserve "CR434")+ `breakOnName`+ ("stuff" :: Named CaseInsensitivePreserve "CR434"))+ `shouldBe`+ ("stuff", "")++ it "CR435 rejects an too-long infix CaseInsensitivePreserve" $+ (("stuffing" :: Named CaseInsensitivePreserve "CR435")+ `breakOnName`+ ("stuff" :: Named CaseInsensitivePreserve "CR435"))+ `shouldBe`+ ("stuff", "")++ it "CR436 accepts a case mismatch CaseInsensitivePreserve" $+ (("STUFF" :: Named CaseInsensitivePreserve "CR436")+ `breakOnName`+ ("stuff" :: Named CaseInsensitivePreserve "CR436"))+ `shouldBe`+ ("", "stuff")++ it "CR437 can check a valid internal infix CaseInsensitivePreserve" $+ (("tUf" :: Named CaseInsensitivePreserve "CR432")+ `breakOnName`+ ("STUFf" :: Named CaseInsensitivePreserve "CR432"))+ `shouldBe`+ ("s", "Tuff")++ it "CR438 can check a valid starting infix CaseInsensitivePreserve" $+ (("st" :: Named CaseInsensitivePreserve "CR438")+ `breakOnName`+ ("STUFF" :: Named CaseInsensitivePreserve "CR438"))+ `shouldBe`+ ("", "stUFf")++ ---------------------------------------------------------------------- -- Data.Name.JSON