character-cases 0.1.0.4 → 0.1.0.5
raw patch · 3 files changed
+214/−21 lines, 3 files
Files
- character-cases.cabal +2/−2
- src/Data/Char/Cases.hs +165/−11
- src/Data/String/Cases.hs +47/−8
character-cases.cabal view
@@ -4,10 +4,10 @@ -- -- see: https://github.com/sol/hpack ----- hash: df032fa0e13ccb8e3d8c1eaa637877af7b521ac787ffa94e2f3d91d64acbfb2d+-- hash: 9ae64163844840cb8871abca02785f7de8a0e19cf7b1793390a33b068ae1a73e name: character-cases-version: 0.1.0.4+version: 0.1.0.5 synopsis: Exposes subspecies types of Char. And naming cases. description: e.g. meaning of [a-z], [A-Z], [0-9], PascalCase, camelCase, and snake_case. Please see https://github.com/aiya000/hs-character-cases#README.md category: Simple
src/Data/Char/Cases.hs view
@@ -2,8 +2,54 @@ -- | -- Exposes subspecies types of Char.--- e.g. [a-z], [A-Z], and [0-9].-module Data.Char.Cases where+-- e.g. `[a-z]`, `[A-Z]`, and `[0-9]`.+module Data.Char.Cases+ ( AlphaNumChar (..)+ , alphaNumToChar+ , alphaNumChar+ , charToAlphaNum+ , alphaNumCharQ+ , AlphaChar (..)+ , alphaToChar+ , charToAlpha+ , alphaChar+ , alphaCharQ+ , UpperChar (..)+ , upperToChar+ , upperChar+ , charToUpper+ , upperCharQ+ , LowerChar (..)+ , lowerToChar+ , lowerChar+ , charToLower+ , lowerCharQ+ , DigitChar (..)+ , digitToChar+ , digitChar+ , charToDigit+ , digitCharQ+ , SnakeChar (..)+ , snakeToChar+ , snakeChar+ , charToSnake+ , snakeCharQ+ , SnakeHeadChar (..)+ , snakeHeadToChar+ , snakeHeadChar+ , charToSnakeHead+ , snakeHeadCharQ+ , UpperSnakeHeadChar (..)+ , upperSnakeHeadToChar+ , upperSnakeHeadChar+ , charToUpperSnakeHead+ , upperSnakeHeadCharQ+ , UpperSnakeChar (..)+ , upperSnakeToChar+ , upperSnakeChar+ , charToUpperSnake+ , upperSnakeCharQ+ ) where import Cases.Megaparsec import Control.Applicative@@ -25,6 +71,7 @@ Map.fromList $ map swap x +-- | '[A-Za-z0-9]' data AlphaNumChar = AlphaNumAlpha AlphaChar | AlphaNumDigit DigitChar deriving (Show, Eq, Ord)@@ -73,6 +120,7 @@ expQ xs@(_ : _) = fail [i|alphaNumCharQ required a Char, but a String is specified: ${xs}|] +-- | '[A-Za-z]' data AlphaChar = AlphaLower LowerChar | AlphaUpper UpperChar deriving (Show, Eq, Ord)@@ -111,6 +159,7 @@ expQ xs@(_ : _) = fail [i|alphaCharQ required a Char, but a String is specified: ${xs}|] +-- | '[A-Z]' data UpperChar = A | B | C | D | E | F | G | H | I | J | K | L | M | N | O | P | Q | R | S | T | U | V | W | X | Y | Z deriving (Show, Eq, Ord) @@ -168,6 +217,7 @@ expQ xs@(_ : _) = fail [i|upperCharQ required a Char, but a String is specified: ${xs}|] +-- | '[a-z]' data LowerChar = A_ | B_ | C_ | D_ | E_ | F_ | G_ | H_ | I_ | J_ | K_ | L_ | M_ | N_ | O_ | P_ | Q_ | R_ | S_ | T_ | U_ | V_ | W_ | X_ | Y_ | Z_ deriving (Show, Eq, Ord) @@ -225,7 +275,7 @@ expQ xs@(_ : _) = fail [i|lowerCharQ required a Char, but a String is specified: ${xs}|] --- | [0-9]+-- | '[0-9]' data DigitChar = D0 | D1 | D2@@ -288,16 +338,16 @@ -- |--- [a-zA-Z0-9_]+-- '[a-zA-Z0-9_]' -- -- Please see 'Snake'. data SnakeChar = SnakeUnderscore -- ^ _ | SnakeAlphaNum AlphaNumChar -- ^ [a-zA-Z0-9] deriving (Show, Eq) -unSnakeChar :: SnakeChar -> Char-unSnakeChar SnakeUnderscore = '_'-unSnakeChar (SnakeAlphaNum x) = alphaNumToChar x+snakeToChar :: SnakeChar -> Char+snakeToChar SnakeUnderscore = '_'+snakeToChar (SnakeAlphaNum x) = alphaNumToChar x snakeChar :: CodeParsing m => m SnakeChar snakeChar =@@ -344,16 +394,16 @@ -- |--- [a-zA-Z_]+-- '[a-zA-Z_]' -- -- Please see 'Snake'. data SnakeHeadChar = SnakeHeadUnderscore | SnakeHeadAlpha AlphaChar deriving (Show, Eq) -unSnakeHeadChar :: SnakeHeadChar -> Char-unSnakeHeadChar SnakeHeadUnderscore = '_'-unSnakeHeadChar (SnakeHeadAlpha x) = alphaToChar x+snakeHeadToChar :: SnakeHeadChar -> Char+snakeHeadToChar SnakeHeadUnderscore = '_'+snakeHeadToChar (SnakeHeadAlpha x) = alphaToChar x snakeHeadChar :: CodeParsing m => m SnakeHeadChar snakeHeadChar =@@ -394,3 +444,107 @@ (ConE (mkName "SnakeHeadAlpha") `AppE`) <$> (quoteExp alphaCharQ) [x] expQ xs@(_ : _) = fail [i|snakeHeadCharQ required a Char, but a String is specified: ${xs}|]+++-- |+-- '[A-Z_]'+--+-- Please sese 'UpperSnake'.+data UpperSnakeHeadChar = UpperSnakeHeadUnderscore -- ^ _+ | UpperSnakeHeadUpper UpperChar -- ^ [A-Z]+ deriving (Show, Eq)++upperSnakeHeadToChar :: UpperSnakeHeadChar -> Char+upperSnakeHeadToChar UpperSnakeHeadUnderscore = '_'+upperSnakeHeadToChar (UpperSnakeHeadUpper x) = upperToChar x++upperSnakeHeadChar :: CodeParsing m => m UpperSnakeHeadChar+upperSnakeHeadChar =+ UpperSnakeHeadUnderscore <$ P.char '_' <|>+ UpperSnakeHeadUpper <$> upperChar++charToUpperSnakeHead :: Char -> Maybe UpperSnakeHeadChar+charToUpperSnakeHead x = P.parseMaybe upperSnakeHeadChar [x]++-- |+-- >>> [upperSnakeHeadCharQ|_|]+-- UpperSnakeHeadUnderscore+--+-- >>> [upperSnakeHeadCharQ|A|]+-- UpperSnakeHeadUpper A+upperSnakeHeadCharQ :: QuasiQuoter+upperSnakeHeadCharQ = QuasiQuoter+ { quoteExp = expQ+ , quotePat = error "not supported"+ , quoteType = error "not supported"+ , quoteDec = error "not supported"+ }+ where+ expQ :: String -> Q Exp+ expQ [] = fail "upperSnakeHeadCharQ required a Char, but nothign is specified."++ expQ (x : []) = case charToUpperSnakeHead x of+ Nothing ->+ fail [i|'${x}' is not a UpperSnakeHeadChar.|]+ Just UpperSnakeHeadUnderscore ->+ conE $ mkName "UpperSnakeHeadUnderscore"+ Just (UpperSnakeHeadUpper _) ->+ (ConE (mkName "UpperSnakeHeadUpper") `AppE`) <$> (quoteExp upperCharQ) [x]++ expQ xs@(_ : _) = fail [i|upperSnakeHeadCharQ required a Char, but a String is specified: ${xs}|]+++-- |+-- '[A-Z0-9_]'+--+-- Please see 'Snake'.+data UpperSnakeChar = UpperSnakeUnderscore -- ^ _+ | UpperSnakeUpper UpperChar -- ^ [A-Z]+ | UpperSnakeDigit DigitChar -- ^ [0-9]+ deriving (Show, Eq)++upperSnakeToChar :: UpperSnakeChar -> Char+upperSnakeToChar UpperSnakeUnderscore = '_'+upperSnakeToChar (UpperSnakeUpper x) = upperToChar x+upperSnakeToChar (UpperSnakeDigit x) = digitToChar x++upperSnakeChar :: CodeParsing m => m UpperSnakeChar+upperSnakeChar =+ UpperSnakeUnderscore <$ P.char '_' <|>+ UpperSnakeUpper <$> upperChar <|>+ UpperSnakeDigit <$> digitChar++charToUpperSnake :: Char -> Maybe UpperSnakeChar+charToUpperSnake x = P.parseMaybe upperSnakeChar [x]++-- |+-- >>> [upperSnakeCharQ|_|]+-- UpperSnakeUnderscore+--+-- >>> [upperSnakeCharQ|A|]+-- UpperSnakeUpper A+--+-- >>> [upperSnakeCharQ|0|]+-- UpperSnakeDigit D0+upperSnakeCharQ :: QuasiQuoter+upperSnakeCharQ = QuasiQuoter+ { quoteExp = expQ+ , quotePat = error "not supported"+ , quoteType = error "not supported"+ , quoteDec = error "not supported"+ }+ where+ expQ :: String -> Q Exp+ expQ [] = fail "upperSnakeCharQ required a Char, but nothign is specified."++ expQ (x : []) = case charToUpperSnake x of+ Nothing ->+ fail [i|'${x}' is not a UpperSnakeChar.|]+ Just UpperSnakeUnderscore ->+ conE $ mkName "UpperSnakeUnderscore"+ Just (UpperSnakeUpper _) ->+ (ConE (mkName "UpperSnakeUpper") `AppE`) <$> (quoteExp upperCharQ) [x]+ Just (UpperSnakeDigit _) ->+ (ConE (mkName "UpperSnakeDigit") `AppE`) <$> (quoteExp digitCharQ) [x]++ expQ xs@(_ : _) = fail [i|upperSnakeCharQ required a Char, but a String is specified: ${xs}|]
src/Data/String/Cases.hs view
@@ -101,13 +101,7 @@ -- | Non empty camelCase names "[a-zA-Z][a-zA-Z0-9]*" data Camel = Camel AlphaChar [AlphaNumChar]- deriving (Eq)---- To easy to debug.------ To strictly check, remove this instance and use `deriving (Show)`.-instance Show Camel where- show (Camel x xs) = '"' : alphaToChar x : map alphaNumToChar xs <> "\""+ deriving (Show, Eq) instance Pretty Camel where pretty = String.fromString . unCamel@@ -153,7 +147,7 @@ unSnake :: Snake -> String unSnake (Snake x xs) =- unSnakeHeadChar x : map unSnakeChar xs+ snakeHeadToChar x : map snakeToChar xs parseSnake :: CodeParsing m => m Snake parseSnake =@@ -187,6 +181,51 @@ z <- (quoteExp snakeHeadCharQ) [x] zs <- mapM (quoteExp snakeCharQ) $ map (: []) xs pure $ ConE (mkName "Snake") `AppE` z `AppE` ListE zs+++-- | A kind of Snake. "[A-Z_][A-Z0-9_]*"+data UpperSnake = UpperSnake UpperSnakeHeadChar [UpperSnakeChar]+ deriving (Show, Eq)++instance Pretty UpperSnake where+ pretty = String.fromString . unUpperSnake++unUpperSnake :: UpperSnake -> String+unUpperSnake (UpperSnake x xs) =+ upperSnakeHeadToChar x : map upperSnakeToChar xs++parseUpperSnake :: CodeParsing m => m UpperSnake+parseUpperSnake =+ UpperSnake <$>+ upperSnakeHeadChar <*>+ P.many upperSnakeChar++-- |+-- >>> [upperSnakeQ|FOO_BAR|]+-- UpperSnake (UpperSnakeHeadUpper F) [UpperSnakeUpper O,UpperSnakeUpper O,UpperSnakeUnderscore,UpperSnakeUpper B,UpperSnakeUpper A,UpperSnakeUpper R]+--+-- >>> [upperSnakeQ|__CONSTRUCTOR|]+-- UpperSnake UpperSnakeHeadUnderscore [UpperSnakeUnderscore,UpperSnakeUpper C,UpperSnakeUpper O,UpperSnakeUpper N,UpperSnakeUpper S,UpperSnakeUpper T,UpperSnakeUpper R,UpperSnakeUpper U,UpperSnakeUpper C,UpperSnakeUpper T,UpperSnakeUpper O,UpperSnakeUpper R]+--+-- >>> [upperSnakeQ|__FOO_MEE_9|]+-- UpperSnake UpperSnakeHeadUnderscore [UpperSnakeUnderscore,UpperSnakeUpper F,UpperSnakeUpper O,UpperSnakeUpper O,UpperSnakeUnderscore,UpperSnakeUpper M,UpperSnakeUpper E,UpperSnakeUpper E,UpperSnakeUnderscore,UpperSnakeDigit D9]+--+-- >>> [upperSnakeQ|FOO_MEE_9|]+-- UpperSnake (UpperSnakeHeadUpper F) [UpperSnakeUpper O,UpperSnakeUpper O,UpperSnakeUnderscore,UpperSnakeUpper M,UpperSnakeUpper E,UpperSnakeUpper E,UpperSnakeUnderscore,UpperSnakeDigit D9]+upperSnakeQ :: QuasiQuoter+upperSnakeQ = QuasiQuoter+ { quoteExp = expQ+ , quotePat = error "not supported"+ , quoteType = error "not supported"+ , quoteDec = error "not supported"+ }+ where+ expQ :: String -> Q Exp+ expQ [] = fail "upperSnakeQ required a non empty string, but the empty string is specified."+ expQ (x : xs) = do+ z <- (quoteExp upperSnakeHeadCharQ) [x]+ zs <- mapM (quoteExp upperSnakeCharQ) $ map (: []) xs+ pure $ ConE (mkName "UpperSnake") `AppE` z `AppE` ListE zs -- | Non empty "veryflatten" names [a-z]+