diff --git a/ascii-superset.cabal b/ascii-superset.cabal --- a/ascii-superset.cabal +++ b/ascii-superset.cabal @@ -1,7 +1,7 @@ cabal-version: 3.0 name: ascii-superset -version: 1.2.3.0 +version: 1.2.4.0 synopsis: Representing ASCII with refined supersets category: Data, Text diff --git a/changelog.md b/changelog.md --- a/changelog.md +++ b/changelog.md @@ -1,3 +1,17 @@ +### 1.2.4.0 (2023-01-05) + +New classes: + +```haskell +class ToCasefulChar (letterCase :: Case) char where + toCasefulChar :: CaselessChar -> char +``` + +```haskell +class ToCasefulString (letterCase :: Case) string where + toCasefulString :: [CaselessChar] -> string +``` + ### 1.2.3.0 (2023-01-05) Add `instance Lift a a` diff --git a/library/ASCII/CaseRefinement.hs b/library/ASCII/CaseRefinement.hs --- a/library/ASCII/CaseRefinement.hs +++ b/library/ASCII/CaseRefinement.hs @@ -102,6 +102,12 @@ toCharListUnsafe = S.toCharListUnsafe . lift toCharListSub = S.toCharListUnsafe . lift +instance (S.FromChar superset, KnownCase letterCase) => S.ToCasefulChar letterCase (ASCII'case letterCase superset) where + toCasefulChar = asciiCaseUnsafe . S.fromChar . Caseless.toCase (theCase @letterCase) + +instance (S.FromString superset, KnownCase letterCase) => S.ToCasefulString letterCase (ASCII'case letterCase superset) where + toCasefulString = asciiCaseUnsafe . S.fromCharList . List.map (Caseless.toCase (theCase @letterCase)) + {-| Change the type of an ASCII superset value that is known to be valid ASCII where letters are restricted to the 'Case' designated by the @letterCase@ type variable diff --git a/library/ASCII/CaseRefinement.hs-boot b/library/ASCII/CaseRefinement.hs-boot new file mode 100644 --- /dev/null +++ b/library/ASCII/CaseRefinement.hs-boot @@ -0,0 +1,8 @@ +module ASCII.CaseRefinement where + +import ASCII.Case (Case (..)) + +class KnownCase (letterCase :: Case) where theCase :: Case + +instance KnownCase 'UpperCase +instance KnownCase 'LowerCase diff --git a/library/ASCII/Superset.hs b/library/ASCII/Superset.hs --- a/library/ASCII/Superset.hs +++ b/library/ASCII/Superset.hs @@ -1,12 +1,12 @@ module ASCII.Superset ( {- * Characters -} - {- ** Class -} ToCaselessChar (..), ToChar (..), FromChar (..), CharSuperset (..), + {- ** Class -} ToCaselessChar (..), ToChar (..), FromChar (..), CharSuperset (..), ToCasefulChar (..), {- ** Functions -} asCharUnsafe, toCharMaybe, toCaselessCharMaybe, toCharOrFail, toCaselessCharOrFail, toCharSub, toCaselessCharSub, substituteChar, convertCharMaybe, convertCharOrFail, {- * Strings -} - {- ** Class -} ToCaselessString (..), ToString (..), FromString (..), StringSuperset (..), + {- ** Class -} ToCaselessString (..), ToString (..), FromString (..), StringSuperset (..), ToCasefulString (..), {- ** Functions -} toCharListMaybe, toCaselessCharListMaybe, toCharListOrFail, toCaselessCharListOrFail, convertStringMaybe, convertStringOrFail ) @@ -14,6 +14,7 @@ import ASCII.Case (Case (..)) import ASCII.Caseless (CaselessChar) +import {-# source #-} ASCII.CaseRefinement (KnownCase (..)) import Control.Monad (return) import Control.Monad.Fail (MonadFail (fail)) import Data.Bool (Bool, (&&)) @@ -99,6 +100,10 @@ the argument unmodified. -} toCaseChar :: Case -> char -> char +class ToCasefulChar (letterCase :: Case) char where + + toCasefulChar :: CaselessChar -> char + {-| Manipulate a character as if it were an ASCII 'ASCII.Char', assuming that it is Defined only where 'isAsciiChar' is satisfied. -} @@ -221,6 +226,10 @@ an ASCII letter of the opposite case. Leaves other characters unchanged. -} toCaseString :: Case -> string -> string +class ToCasefulString (letterCase :: Case) string where + + toCasefulString :: [CaselessChar] -> string + toCharListMaybe :: ToString string => string -> Maybe [ASCII.Char] toCharListMaybe = toCharListOrFail @@ -281,6 +290,9 @@ instance CharSuperset ASCII.Char where toCaseChar = Case.toCase +instance KnownCase letterCase => ToCasefulChar letterCase ASCII.Char where + toCasefulChar = Caseless.toCase (theCase @letterCase) + --- instance ToCaselessChar Unicode.Char where @@ -299,6 +311,9 @@ toCaseChar LowerCase x | x >= 'A' && x <= 'Z' = Unicode.chr (Unicode.ord x + 32) toCaseChar _ x = x +instance KnownCase letterCase => ToCasefulChar letterCase Unicode.Char where + toCasefulChar = fromChar . toCasefulChar @letterCase + --- instance ToCaselessChar Nat.Natural where @@ -317,6 +332,9 @@ toCaseChar LowerCase x | x >= 65 && x <= 90 = x + 32 toCaseChar _ x = x +instance KnownCase letterCase => ToCasefulChar letterCase Nat.Natural where + toCasefulChar = fromChar . toCasefulChar @letterCase + --- instance ToCaselessChar Int.Int where @@ -335,6 +353,9 @@ toCaseChar LowerCase x | x >= 65 && x <= 90 = x + 32 toCaseChar _ x = x +instance KnownCase letterCase => ToCasefulChar letterCase Int.Int where + toCasefulChar = fromChar . toCasefulChar @letterCase + --- instance ToCaselessChar Word.Word8 where @@ -353,6 +374,9 @@ toCaseChar LowerCase x | x >= 65 && x <= 90 = x + 32 toCaseChar _ x = x +instance KnownCase letterCase => ToCasefulChar letterCase Word.Word8 where + toCasefulChar = fromChar . toCasefulChar @letterCase + --- instance ToCaselessChar char => ToCaselessString [char] where @@ -372,6 +396,9 @@ substituteString = List.map substituteChar toCaseString c = List.map (toCaseChar c) +instance (ToCasefulChar letterCase char, KnownCase letterCase) => ToCasefulString letterCase [char] where + toCasefulString = List.map (toCasefulChar @letterCase) + --- instance ToCaselessString T.Text where @@ -392,6 +419,9 @@ mapCharsUnsafe f = T.map (asCharUnsafe f) toCaseString c = T.map (toCaseChar c) +instance KnownCase letterCase => ToCasefulString letterCase T.Text where + toCasefulString = fromCharList . toCasefulString @letterCase + --- instance ToCaselessString LT.Text where @@ -412,6 +442,9 @@ mapCharsUnsafe f = LT.map (asCharUnsafe f) toCaseString c = LT.map (toCaseChar c) +instance KnownCase letterCase => ToCasefulString letterCase LT.Text where + toCasefulString = fromCharList . toCasefulString @letterCase + --- instance ToCaselessString TB.Builder where @@ -432,6 +465,9 @@ mapCharsUnsafe f = TB.fromLazyText . mapCharsUnsafe f . TB.toLazyText toCaseString c = TB.fromLazyText . toCaseString c . TB.toLazyText +instance KnownCase letterCase => ToCasefulString letterCase TB.Builder where + toCasefulString = fromCharList . toCasefulString @letterCase + --- instance ToCaselessString BS.ByteString where @@ -452,6 +488,9 @@ mapCharsUnsafe f = BS.map (asCharUnsafe f) toCaseString c = BS.map (toCaseChar c) +instance KnownCase letterCase => ToCasefulString letterCase BS.ByteString where + toCasefulString = fromCharList . toCasefulString @letterCase + --- instance ToCaselessString LBS.ByteString where @@ -472,6 +511,9 @@ mapCharsUnsafe f = LBS.map (asCharUnsafe f) toCaseString c = LBS.map (toCaseChar c) +instance KnownCase letterCase => ToCasefulString letterCase LBS.ByteString where + toCasefulString = fromCharList . toCasefulString @letterCase + --- instance ToCaselessString BSB.Builder where @@ -491,3 +533,6 @@ substituteString = BSB.lazyByteString . substituteString . BSB.toLazyByteString mapCharsUnsafe f = BSB.lazyByteString . mapCharsUnsafe f . BSB.toLazyByteString toCaseString c = BSB.lazyByteString . toCaseString c . BSB.toLazyByteString + +instance KnownCase letterCase => ToCasefulString letterCase BSB.Builder where + toCasefulString = fromCharList . toCasefulString @letterCase diff --git a/test/Main.hs b/test/Main.hs --- a/test/Main.hs +++ b/test/Main.hs @@ -169,3 +169,39 @@ let x = asciiUnsafe "Hi!" :: ASCII Text CaseRefinement.refineStringToCase x `shouldBe` (asciiCaseUnsafe "HI!" :: ASCII'upper Text) CaseRefinement.refineStringToCase x `shouldBe` (asciiCaseUnsafe "hi!" :: ASCII'lower Text) + + describe "toCasefulChar" $ do + + describe "lower case" $ do + let a :: Superset.ToCasefulChar 'LowerCase char => char + a = Superset.toCasefulChar @'LowerCase CC.LetterA + + it "can be Char" $ a `shouldBe` SmallLetterA + it "can be superset type" $ a `shouldBe` 'a' + it "can be case-refined type" $ a `shouldBe` (asciiCaseUnsafe 'a' :: ASCII'lower Unicode.Char) + + describe "upper case" $ do + let a :: Superset.ToCasefulChar 'UpperCase char => char + a = Superset.toCasefulChar @'UpperCase CC.LetterA + + it "can be Char" $ a `shouldBe` CapitalLetterA + it "can be superset type" $ a `shouldBe` 'A' + it "can be case-refined type" $ a `shouldBe` (asciiCaseUnsafe 'A' :: ASCII'upper Unicode.Char) + + describe "toCasefulString" $ do + + describe "lower case" $ do + let x :: Superset.ToCasefulString 'LowerCase string => string + x = Superset.toCasefulString @'LowerCase [CC.LetterH, CC.LetterI, CC.ExclamationMark] + + it "can be [Char]" $ x `shouldBe` [SmallLetterH, SmallLetterI, ExclamationMark] + it "can be superset type" $ x `shouldBe` ("hi!" :: Text) + it "can be case-refined type" $ x `shouldBe` (asciiCaseUnsafe "hi!" :: ASCII'lower Text) + + describe "upper case" $ do + let x :: Superset.ToCasefulString 'UpperCase string => string + x = Superset.toCasefulString @'UpperCase [CC.LetterH, CC.LetterI, CC.ExclamationMark] + + it "can be [Char]" $ x `shouldBe` [CapitalLetterH, CapitalLetterI, ExclamationMark] + it "can be superset type" $ x `shouldBe` ("HI!" :: Text) + it "can be case-refined type" $ x `shouldBe` (asciiCaseUnsafe "HI!" :: ASCII'upper Text)