packages feed

character-cases (empty) → 0.1.0.0

raw patch · 7 files changed

+774/−0 lines, 7 filesdep +Globdep +basedep +containerssetup-changed

Dependencies added: Glob, base, containers, doctest, here, megaparsec, prettyprinter, template-haskell

Files

+ LICENSE view
@@ -0,0 +1,21 @@+The MIT License (MIT)++Copyright (c) 2020 aiya000++Permission is hereby granted, free of charge, to any person obtaining a copy+of this software and associated documentation files (the "Software"), to deal+in the Software without restriction, including without limitation the rights+to use, copy, modify, merge, publish, distribute, sublicense, and/or sell+copies of the Software, and to permit persons to whom the Software is+furnished to do so, subject to the following conditions:++The above copyright notice and this permission notice shall be included in+all copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR+IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,+FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE+AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER+LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,+OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN+THE SOFTWARE.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ character-cases.cabal view
@@ -0,0 +1,69 @@+cabal-version: 1.12++-- This file has been generated from package.yaml by hpack version 0.31.2.+--+-- see: https://github.com/sol/hpack+--+-- hash: 9b9be05bf0dac06ddeb62fdb730a6ee545b40639db89c4052d0d900da0aa40a5++name:           character-cases+version:        0.1.0.0+synopsis:       Exposes subspecies types of Char. And naming cases. e.g. meaning of [a-z], [A-Z], [0-9], PascalCase, camelCase, and sneak_case.+description:    Please see https://github.com/aiya000/hs-character-cases#README.md+category:       Simple+homepage:       https://github.com/aiya000/hs-character-cases#readme+bug-reports:    https://github.com/aiya000/hs-character-cases/issues+author:         aiya000+maintainer:     aiya000.develop@gmail.com+copyright:      aiya000+license:        MIT+license-file:   LICENSE+build-type:     Simple++source-repository head+  type: git+  location: https://github.com/aiya000/hs-character-cases++library+  exposed-modules:+      Cases.Megaparsec+      Data.Char.Cases+      Data.String.Cases+  other-modules:+      Paths_character_cases+  hs-source-dirs:+      src+  default-extensions: AutoDeriveTypeable BangPatterns BinaryLiterals BlockArguments ConstraintKinds DataKinds DefaultSignatures DeriveDataTypeable DeriveFoldable DeriveFunctor DeriveGeneric DeriveTraversable DoAndIfThenElse DuplicateRecordFields EmptyDataDecls ExistentialQuantification FlexibleContexts FlexibleInstances FunctionalDependencies GADTs GeneralizedNewtypeDeriving InstanceSigs KindSignatures LambdaCase MonadFailDesugaring MultiParamTypeClasses MultiWayIf NamedFieldPuns OverloadedStrings PartialTypeSignatures PatternGuards PolyKinds RankNTypes RecordWildCards ScopedTypeVariables StandaloneDeriving TupleSections TypeApplications TypeFamilies TypeSynonymInstances ViewPatterns+  ghc-options: -Wall -Wcompat -Wincomplete-record-updates -Wincomplete-uni-patterns -Wredundant-constraints -fprint-explicit-kinds -fprint-potential-instances+  build-depends:+      base >=4.7 && <5+    , containers+    , here+    , megaparsec+    , prettyprinter+    , template-haskell+  default-language: Haskell2010++test-suite doctest+  type: exitcode-stdio-1.0+  main-is: Main.hs+  other-modules:+      Cases.Megaparsec+      Data.Char.Cases+      Data.String.Cases+      Paths_character_cases+  hs-source-dirs:+      test/doctest+      src+  default-extensions: AutoDeriveTypeable BangPatterns BinaryLiterals BlockArguments ConstraintKinds DataKinds DefaultSignatures DeriveDataTypeable DeriveFoldable DeriveFunctor DeriveGeneric DeriveTraversable DoAndIfThenElse DuplicateRecordFields EmptyDataDecls ExistentialQuantification FlexibleContexts FlexibleInstances FunctionalDependencies GADTs GeneralizedNewtypeDeriving InstanceSigs KindSignatures LambdaCase MonadFailDesugaring MultiParamTypeClasses MultiWayIf NamedFieldPuns OverloadedStrings PartialTypeSignatures PatternGuards PolyKinds RankNTypes RecordWildCards ScopedTypeVariables StandaloneDeriving TupleSections TypeApplications TypeFamilies TypeSynonymInstances ViewPatterns+  ghc-options: -Wall -Wcompat -Wincomplete-record-updates -Wincomplete-uni-patterns -Wredundant-constraints -fprint-explicit-kinds -fprint-potential-instances -threaded -rtsopts -with-rtsopts=-N+  build-depends:+      Glob+    , base >=4.7 && <5+    , containers+    , doctest+    , here+    , megaparsec+    , prettyprinter+    , template-haskell+  default-language: Haskell2010
+ src/Cases/Megaparsec.hs view
@@ -0,0 +1,6 @@+module Cases.Megaparsec where++import Data.Void+import Text.Megaparsec (MonadParsec)++type CodeParsing = MonadParsec Void String
+ src/Data/Char/Cases.hs view
@@ -0,0 +1,396 @@+{-# LANGUAGE QuasiQuotes #-}++-- |+-- Exposes subspecies types of Char.+-- e.g. [a-z], [A-Z], and [0-9].+module Data.Char.Cases where++import Cases.Megaparsec+import Control.Applicative+import Data.Map.Strict (Map)+import qualified Data.Map.Strict as Map+import Data.Maybe (fromJust)+import Data.String.Here (i)+import Data.Tuple (swap)+import Language.Haskell.TH+import Language.Haskell.TH.Quote (QuasiQuoter(..))+import qualified Text.Megaparsec as P+import qualified Text.Megaparsec.Char as P++-- $setup+-- >>> :set -XQuasiQuotes++dual :: Ord a => Map k a -> Map a k+dual (Map.toList -> x) =+  Map.fromList $ map swap x+++data AlphaNumChar = AlphaNumAlpha AlphaChar+                  | AlphaNumDigit DigitChar+  deriving (Show, Eq, Ord)++alphaNumToChar :: AlphaNumChar -> Char+alphaNumToChar (AlphaNumAlpha x) = alphaToChar x+alphaNumToChar (AlphaNumDigit x) = digitToChar x++alphaNumChar :: CodeParsing m => m AlphaNumChar+alphaNumChar =+  AlphaNumAlpha <$> alphaChar <|>+  AlphaNumDigit <$> digitChar++charToAlphaNum :: Char -> Maybe AlphaNumChar+charToAlphaNum x = P.parseMaybe alphaNumChar [x]++-- |+-- Simular to 'alphaCharQ' and 'digitCharQ'.+--+-- >>> [alphaNumCharQ|x|]+-- AlphaNumAlpha (AlphaLower X_)+--+-- >>> [alphaNumCharQ|X|]+-- AlphaNumAlpha (AlphaUpper X)+--+-- >>> [alphaNumCharQ|1|]+-- AlphaNumDigit D1+alphaNumCharQ :: QuasiQuoter+alphaNumCharQ = QuasiQuoter+  { quoteExp  = expQ+  , quotePat  = error "not supported"+  , quoteType = error "not supported"+  , quoteDec  = error "not supported"+  }+  where+    expQ :: String -> Q Exp+    expQ [] = fail "alphaNumCharQ required a Char, but nothign is specified."++    expQ (x : []) = case charToAlphaNum x of+      Nothing -> fail [i|'${x}' is not an AlphaNumChar.|]+      Just (AlphaNumAlpha _) ->+        (ConE (mkName "AlphaNumAlpha") `AppE`) <$> (quoteExp alphaCharQ) [x]+      Just (AlphaNumDigit _) ->+        (ConE (mkName "AlphaNumDigit") `AppE`) <$> (quoteExp digitCharQ) [x]++    expQ xs@(_ : _) = fail [i|alphaNumCharQ required a Char, but a String is specified: ${xs}|]+++data AlphaChar = AlphaLower LowerChar+               | AlphaUpper UpperChar+  deriving (Show, Eq, Ord)++alphaToChar :: AlphaChar -> Char+alphaToChar (AlphaLower x) = lowerToChar x+alphaToChar (AlphaUpper x) = upperToChar x++charToAlpha :: Char -> Maybe AlphaChar+charToAlpha x = P.parseMaybe alphaChar [x]++alphaChar :: CodeParsing m => m AlphaChar+alphaChar =+  AlphaLower <$> lowerChar <|>+  AlphaUpper <$> upperChar++-- | Simular to 'lowerCharQ' and 'upperCharQ'.+alphaCharQ :: QuasiQuoter+alphaCharQ = QuasiQuoter+  { quoteExp  = expQ+  , quotePat  = error "not supported"+  , quoteType = error "not supported"+  , quoteDec  = error "not supported"+  }+  where+    expQ :: String -> Q Exp+    expQ [] = fail "alphaCharQ required a Char, but nothign is specified."++    expQ (x : []) = case charToAlpha x of+      Nothing -> fail [i|'${x}' is not an AlphaChar.|]+      Just (AlphaLower _) ->+        (ConE (mkName "AlphaLower") `AppE`) <$> (quoteExp lowerCharQ) [x]+      Just (AlphaUpper _) ->+        (ConE (mkName "AlphaUpper") `AppE`) <$> (quoteExp upperCharQ) [x]++    expQ xs@(_ : _) = fail [i|alphaCharQ required a Char, but a String is specified: ${xs}|]+++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)++upperToChar :: UpperChar -> Char+upperToChar = fromJust . flip Map.lookup uppers++uppers :: Map UpperChar Char+uppers = Map.fromList+  [ (A, 'A'), (B, 'B'), (C, 'C')+  , (D, 'D'), (E, 'E'), (F, 'F')+  , (G, 'G'), (H, 'H'), (I, 'I')+  , (J, 'J'), (K, 'K'), (L, 'L')+  , (M, 'M'), (N, 'N'), (O, 'O')+  , (P, 'P'), (Q, 'Q'), (R, 'R')+  , (S, 'S'), (T, 'T'), (U, 'U')+  , (V, 'V'), (W, 'W'), (X, 'X')+  , (Y, 'Y'), (Z, 'Z')+  ]++upperChar :: CodeParsing m => m UpperChar+upperChar = do+  char <- P.upperChar+  let maybeUpper = Map.lookup char $ dual uppers+  case maybeUpper of+    Nothing -> fail "non upper char"+    Just x -> pure x++charToUpper :: Char -> Maybe UpperChar+charToUpper x = P.parseMaybe upperChar [x]++-- |+-- Extracts a Char of [A-Z].+-- Also throws compile error if non [A-Z] is passed.+--+-- >>> [upperCharQ|X|]+-- X+--+-- >>> [upperCharQ|Y|]+-- Y+upperCharQ :: QuasiQuoter+upperCharQ = QuasiQuoter+  { quoteExp  = expQ+  , quotePat  = error "not supported"+  , quoteType = error "not supported"+  , quoteDec  = error "not supported"+  }+  where+    expQ :: String -> Q Exp+    expQ [] = fail "upperCharQ required a Char, but nothign is specified."++    expQ (x : []) = case charToUpper x of+      Nothing -> fail [i|'${x}' is not an UpperChar.|]+      Just z -> conE . mkName $ show z++    expQ xs@(_ : _) = fail [i|upperCharQ required a Char, but a String is specified: ${xs}|]+++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)++lowerToChar :: LowerChar -> Char+lowerToChar = fromJust . flip Map.lookup lowers++lowers :: Map LowerChar Char+lowers = Map.fromList+  [ (A_, 'a'), (B_, 'b'), (C_, 'c')+  , (D_, 'd'), (E_, 'e'), (F_, 'f')+  , (G_, 'g'), (H_, 'h'), (I_, 'i')+  , (J_, 'j'), (K_, 'k'), (L_, 'l')+  , (M_, 'm'), (N_, 'n'), (O_, 'o')+  , (P_, 'p'), (Q_, 'q'), (R_, 'r')+  , (S_, 's'), (T_, 't'), (U_, 'u')+  , (V_, 'v'), (W_, 'w'), (X_, 'x')+  , (Y_, 'y'), (Z_, 'z')+  ]++lowerChar :: CodeParsing m => m LowerChar+lowerChar = do+  char <- P.lowerChar+  let maybeLower = Map.lookup char $ dual lowers+  case maybeLower of+    Nothing -> fail "non lower char"+    Just x -> pure x++charToLower :: Char -> Maybe LowerChar+charToLower x = P.parseMaybe lowerChar [x]++-- |+-- Extracts a Char of [a-z].+-- Also throws compile error if non [a-z] is passed.+--+-- >>> [lowerCharQ|x|]+-- X_+--+-- >>> [lowerCharQ|y|]+-- Y_+lowerCharQ :: QuasiQuoter+lowerCharQ = QuasiQuoter+  { quoteExp  = expQ+  , quotePat  = error "not supported"+  , quoteType = error "not supported"+  , quoteDec  = error "not supported"+  }+  where+    expQ :: String -> Q Exp+    expQ [] = fail "lowerCharQ required a Char, but nothign is specified."++    expQ (x : []) = case charToLower x of+      Nothing -> fail [i|'${x}' is not a LowerChar.|]+      Just z -> conE . mkName $ show z++    expQ xs@(_ : _) = fail [i|lowerCharQ required a Char, but a String is specified: ${xs}|]+++-- | [0-9]+data DigitChar = D0+               | D1+               | D2+               | D3+               | D4+               | D5+               | D6+               | D7+               | D8+               | D9+  deriving (Show, Eq, Ord)++digitToChar :: DigitChar -> Char+digitToChar = fromJust . flip Map.lookup digits++digits :: Map DigitChar Char+digits = Map.fromList+  [ (D0, '0')+  , (D1, '1'), (D2, '2'), (D3, '3')+  , (D4, '4'), (D5, '5'), (D6, '6')+  , (D4, '7'), (D8, '8'), (D9, '9')+  ]++digitChar :: CodeParsing m => m DigitChar+digitChar = do+  char <- P.digitChar+  let maybeNum = Map.lookup char $ dual digits+  case maybeNum of+    Nothing -> fail "non numeric char"+    Just x -> pure x++charToDigit :: Char -> Maybe DigitChar+charToDigit x = P.parseMaybe digitChar [x]++-- |+-- Extracts a Char of [0-9].+-- Also throws compile error if non [a-z] is passed.+--+-- >>> [digitCharQ|0|]+-- D0+--+-- >>> [digitCharQ|9|]+-- D9+digitCharQ :: QuasiQuoter+digitCharQ = QuasiQuoter+  { quoteExp  = expQ+  , quotePat  = error "not supported"+  , quoteType = error "not supported"+  , quoteDec  = error "not supported"+  }+  where+    expQ :: String -> Q Exp+    expQ [] = fail "digitCharQ required a Char, but nothign is specified."++    expQ (x : []) = case charToDigit x of+      Nothing -> fail [i|'${x}' is not a DigitChar.|]+      Just z -> conE . mkName $ show z++    expQ xs@(_ : _) = fail [i|digitCharQ required a Char, but a String is specified: ${xs}|]+++-- |+-- [a-zA-Z0-9_]+--+-- Please see 'Sneak'.+data SneakChar = SneakUnderscore -- ^ _+               | SneakAlphaNum AlphaNumChar -- ^ [a-zA-Z0-9]+  deriving (Show, Eq)++unSneakChar :: SneakChar -> Char+unSneakChar SneakUnderscore = '_'+unSneakChar (SneakAlphaNum x) = alphaNumToChar x++sneakChar :: CodeParsing m => m SneakChar+sneakChar =+  SneakUnderscore <$ P.char '_' <|>+  SneakAlphaNum <$> alphaNumChar++charToSneak :: Char -> Maybe SneakChar+charToSneak x = P.parseMaybe sneakChar [x]++-- |+-- Extracts a Char of [a-zA-Z0-9_].+-- Also throws compile error if non [a-zA-Z0-9_] is passed.+--+-- >>> [sneakCharQ|x|]+-- SneakAlphaNum (AlphaNumAlpha (AlphaLower X_))+--+-- >>> [sneakCharQ|X|]+-- SneakAlphaNum (AlphaNumAlpha (AlphaUpper X))+--+-- >>> [sneakCharQ|_|]+-- SneakUnderscore+--+-- >>> [sneakCharQ|9|]+-- SneakAlphaNum (AlphaNumDigit D9)+sneakCharQ :: QuasiQuoter+sneakCharQ = QuasiQuoter+  { quoteExp  = expQ+  , quotePat  = error "not supported"+  , quoteType = error "not supported"+  , quoteDec  = error "not supported"+  }+  where+    expQ :: String -> Q Exp+    expQ [] = fail "sneakCharQ required a Char, but nothign is specified."++    expQ (x : []) = case charToSneak x of+      Nothing -> fail [i|'${x}' is not a SneakChar.|]+      Just SneakUnderscore ->+        conE $ mkName "SneakUnderscore"+      Just (SneakAlphaNum _) ->+        (ConE (mkName "SneakAlphaNum") `AppE`) <$> (quoteExp alphaNumCharQ) [x]++    expQ xs@(_ : _) = fail [i|sneakCharQ required a Char, but a String is specified: ${xs}|]+++-- |+-- [a-zA-Z_]+--+-- Please see 'Sneak'.+data SneakHeadChar = SneakHeadUnderscore+                   | SneakHeadAlpha AlphaChar+  deriving (Show, Eq)++unSneakHeadChar :: SneakHeadChar -> Char+unSneakHeadChar SneakHeadUnderscore = '_'+unSneakHeadChar (SneakHeadAlpha x) = alphaToChar x++sneakHeadChar :: CodeParsing m => m SneakHeadChar+sneakHeadChar =+  SneakHeadUnderscore <$ P.char '_' <|>+  SneakHeadAlpha <$> alphaChar++charToSneakHead :: Char -> Maybe SneakHeadChar+charToSneakHead x = P.parseMaybe sneakHeadChar [x]++-- |+-- Extracts a Char of [a-zA-Z_].+-- Also throws compile error if non [a-zA-Z_] is passed.+--+-- >>> [sneakHeadCharQ|x|]+-- SneakHeadAlpha (AlphaLower X_)+--+-- >>> [sneakHeadCharQ|X|]+-- SneakHeadAlpha (AlphaUpper X)+--+-- >>> [sneakHeadCharQ|_|]+-- SneakHeadUnderscore+sneakHeadCharQ :: QuasiQuoter+sneakHeadCharQ = QuasiQuoter+  { quoteExp  = expQ+  , quotePat  = error "not supported"+  , quoteType = error "not supported"+  , quoteDec  = error "not supported"+  }+  where+    expQ :: String -> Q Exp+    expQ [] = fail "sneakHeadCharQ required a Char, but nothign is specified."++    expQ (x : []) = case charToSneakHead x of+      Nothing -> fail [i|'${x}' is not a SneakHeadChar.|]+      Just SneakHeadUnderscore ->+        conE $ mkName "SneakHeadUnderscore"+      Just (SneakHeadAlpha _) ->+        (ConE (mkName "SneakHeadAlpha") `AppE`) <$> (quoteExp alphaCharQ) [x]++    expQ xs@(_ : _) = fail [i|sneakHeadCharQ required a Char, but a String is specified: ${xs}|]
+ src/Data/String/Cases.hs view
@@ -0,0 +1,224 @@+{-# LANGUAGE ConstraintKinds #-}+{-# LANGUAGE PatternSynonyms #-}+{-# LANGUAGE QuasiQuotes #-}++-- | Exposes naming cases.+module Data.String.Cases where++import Cases.Megaparsec+import Data.Char.Cases+import qualified Data.String as String+import Data.Text.Prettyprint.Doc (Pretty(..))+import Language.Haskell.TH+import Language.Haskell.TH.Quote (QuasiQuoter(..))+import qualified Text.Megaparsec as P++-- $setup+-- >>> :set -XQuasiQuotes++-- | Non empty PascalCase names "[A-Z][a-zA-Z0-9]*"+data Pascal = Pascal UpperChar [AlphaNumChar]+  deriving (Show, Eq)++instance Pretty Pascal where+  pretty = String.fromString . unPascal++unPascal :: Pascal -> String+unPascal (Pascal x xs) =+  upperToChar x : map alphaNumToChar xs++parsePascal :: CodeParsing m => m Pascal+parsePascal =+  Pascal <$> upperChar <*> P.many alphaNumChar++-- |+-- Simular to 'nonEmptyQ',+-- but naming outsides of 'Pascal' will be rejected.+--+-- >>> [pascalQ|Pascal|]+-- Pascal P [AlphaNumAlpha (AlphaLower A_),AlphaNumAlpha (AlphaLower S_),AlphaNumAlpha (AlphaLower C_),AlphaNumAlpha (AlphaLower A_),AlphaNumAlpha (AlphaLower L_)]+pascalQ :: QuasiQuoter+pascalQ = QuasiQuoter+  { quoteExp  = expQ+  , quotePat  = error "not supported"+  , quoteType = error "not supported"+  , quoteDec  = error "not supported"+  }+  where+    expQ :: String -> Q Exp+    expQ [] = fail "pascalQ required a non empty string, but the empty string is specified."+    expQ (x : xs) = do+      z <- (quoteExp upperCharQ) [x]+      zs <- mapM (quoteExp alphaNumCharQ) $ map (: []) xs+      pure $ ConE (mkName "Pascal") `AppE` z `AppE` ListE zs+++-- | Non empty names ".+"+data NonEmpty = NonEmpty Char String+  deriving (Show, Eq)++instance Pretty NonEmpty where+  pretty = String.fromString . unNonEmpty++unNonEmpty :: NonEmpty -> String+unNonEmpty (NonEmpty x xs) = x : xs++parseNonEmpty :: CodeParsing m => m NonEmpty+parseNonEmpty =+  NonEmpty <$> P.anySingle <*> P.many P.anySingle++fromString :: String -> Maybe NonEmpty+fromString "" = Nothing+fromString (x : xs) = Just $ NonEmpty x xs++-- |+-- Makes a non empty string from String on the compile time.+-- Also throws compile error if the empty string is passed.+--+-- >>> [nonEmptyQ|x|]+-- NonEmpty 'x' ""+--+-- >>> [nonEmptyQ|foo|]+-- NonEmpty 'f' "oo"+--+-- >>> [nonEmptyQ|Bar|]+-- NonEmpty 'B' "ar"+nonEmptyQ :: QuasiQuoter+nonEmptyQ = QuasiQuoter+  { quoteExp  = expQ+  , quotePat  = error "not supported"+  , quoteType = error "not supported"+  , quoteDec  = error "not supported"+  }+  where+    expQ :: String -> Q Exp+    expQ [] = fail "nonEmptyQ required a non empty string, but the empty string is specified."+    expQ (x : xs) =+      pure $ ConE (mkName "NonEmpty")+        `AppE` LitE (CharL x)+        `AppE` ListE (map (LitE . CharL) xs)+++-- | 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 <> "\""++instance Pretty Camel where+  pretty = String.fromString . unCamel++unCamel :: Camel -> String+unCamel (Camel x xs) = alphaToChar x : map alphaNumToChar xs++parseCamel :: CodeParsing m => m Camel+parseCamel =+  Camel <$> alphaChar <*> P.many alphaNumChar++-- |+-- Simular to 'nonEmptyQ',+-- but naming outsides of 'Camel' will be rejected.+--+-- >>> [camelQ|camel|]+-- "camel"+--+-- >>> [camelQ|Pascal|]+-- "Pascal"+camelQ :: QuasiQuoter+camelQ = QuasiQuoter+  { quoteExp  = expQ+  , quotePat  = error "not supported"+  , quoteType = error "not supported"+  , quoteDec  = error "not supported"+  }+  where+    expQ :: String -> Q Exp+    expQ [] = fail "camelQ required a non empty string, but the empty string is specified."+    expQ (x : xs) = do+      z <- (quoteExp alphaCharQ) [x]+      zs <- mapM (quoteExp alphaNumCharQ) $ map (: []) xs+      pure $ ConE (mkName "Camel") `AppE` z `AppE` ListE zs+++-- | Non empty sneak_case names "[a-zA-Z_][a-zA-Z0-9_]*"+data Sneak = Sneak SneakHeadChar [SneakChar]+  deriving (Show, Eq)++instance Pretty Sneak where+  pretty = String.fromString . unSneakCase++unSneakCase :: Sneak -> String+unSneakCase (Sneak x xs) =+  unSneakHeadChar x : map unSneakChar xs++parseSneakCase :: CodeParsing m => m Sneak+parseSneakCase =+  Sneak <$>+  sneakHeadChar <*>+  P.many sneakChar++-- |+-- Simular to 'nonEmptyQ',+-- but naming outsides of 'Sneak' will be rejected.+--+-- >>> [sneakQ|foo_bar|]+-- Sneak (SneakHeadAlpha (AlphaLower F_)) [SneakAlphaNum (AlphaNumAlpha (AlphaLower O_)),SneakAlphaNum (AlphaNumAlpha (AlphaLower O_)),SneakUnderscore,SneakAlphaNum (AlphaNumAlpha (AlphaLower B_)),SneakAlphaNum (AlphaNumAlpha (AlphaLower A_)),SneakAlphaNum (AlphaNumAlpha (AlphaLower R_))]+--+-- >>> [sneakQ|__constructor|]+-- Sneak SneakHeadUnderscore [SneakUnderscore,SneakAlphaNum (AlphaNumAlpha (AlphaLower C_)),SneakAlphaNum (AlphaNumAlpha (AlphaLower O_)),SneakAlphaNum (AlphaNumAlpha (AlphaLower N_)),SneakAlphaNum (AlphaNumAlpha (AlphaLower S_)),SneakAlphaNum (AlphaNumAlpha (AlphaLower T_)),SneakAlphaNum (AlphaNumAlpha (AlphaLower R_)),SneakAlphaNum (AlphaNumAlpha (AlphaLower U_)),SneakAlphaNum (AlphaNumAlpha (AlphaLower C_)),SneakAlphaNum (AlphaNumAlpha (AlphaLower T_)),SneakAlphaNum (AlphaNumAlpha (AlphaLower O_)),SneakAlphaNum (AlphaNumAlpha (AlphaLower R_))]+--+-- >>> [sneakQ|FOO_MEE_9|]+-- Sneak (SneakHeadAlpha (AlphaUpper F)) [SneakAlphaNum (AlphaNumAlpha (AlphaUpper O)),SneakAlphaNum (AlphaNumAlpha (AlphaUpper O)),SneakUnderscore,SneakAlphaNum (AlphaNumAlpha (AlphaUpper M)),SneakAlphaNum (AlphaNumAlpha (AlphaUpper E)),SneakAlphaNum (AlphaNumAlpha (AlphaUpper E)),SneakUnderscore,SneakAlphaNum (AlphaNumDigit D9)]+sneakQ :: QuasiQuoter+sneakQ = QuasiQuoter+  { quoteExp  = expQ+  , quotePat  = error "not supported"+  , quoteType = error "not supported"+  , quoteDec  = error "not supported"+  }+  where+    expQ :: String -> Q Exp+    expQ [] = fail "sneakQ required a non empty string, but the empty string is specified."+    expQ (x : xs) = do+      z <- (quoteExp sneakHeadCharQ) [x]+      zs <- mapM (quoteExp sneakCharQ) $ map (: []) xs+      pure $ ConE (mkName "Sneak") `AppE` z `AppE` ListE zs+++-- | Non empty "veryflatten" names [a-z]++data LowerString = LowerString LowerChar [LowerChar]+  deriving (Show, Eq)++instance Pretty LowerString where+  pretty (LowerString x xs) = String.fromString $ map lowerToChar (x : xs)++unLowerString :: LowerString -> String+unLowerString (LowerString x xs) = lowerToChar x : map lowerToChar xs++parseLowerString :: CodeParsing m => m LowerString+parseLowerString = LowerString <$> lowerChar <*> P.many lowerChar++-- |+-- Simular to 'nonEmptyQ',+-- but naming outsides of 'LowerString' will be rejected.+--+-- >>> [lowerStringQ|imavimmer|]+-- LowerString I_ [M_,A_,V_,I_,M_,M_,E_,R_]+lowerStringQ :: QuasiQuoter+lowerStringQ = QuasiQuoter+  { quoteExp  = expQ+  , quotePat  = error "not supported"+  , quoteType = error "not supported"+  , quoteDec  = error "not supported"+  }+  where+    expQ :: String -> Q Exp+    expQ [] = fail "lowerStringQ required a non empty string, but the empty string is specified."+    expQ (x : xs) = do+      z <- (quoteExp lowerCharQ) [x]+      zs <- mapM (quoteExp lowerCharQ) $ map (: []) xs+      pure $ ConE (mkName "LowerString") `AppE` z `AppE` ListE zs
+ test/doctest/Main.hs view
@@ -0,0 +1,56 @@+module Main where++import System.FilePath.Glob (glob)+import Test.DocTest (doctest)++main :: IO ()+main = glob "src/**/*.hs" >>= runDocTest+  where++runDocTest :: [String] -> IO ()+runDocTest options =+  doctest $ options <> ghcExtensions++ghcExtensions :: [String]+ghcExtensions =+    [ "-XAutoDeriveTypeable"+    , "-XBangPatterns"+    , "-XBinaryLiterals"+    , "-XConstraintKinds"+    , "-XDataKinds"+    , "-XDefaultSignatures"+    , "-XDeriveDataTypeable"+    , "-XDeriveFoldable"+    , "-XDeriveFunctor"+    , "-XDeriveGeneric"+    , "-XDeriveTraversable"+    , "-XDoAndIfThenElse"+    , "-XDuplicateRecordFields"+    , "-XEmptyDataDecls"+    , "-XExistentialQuantification"+    , "-XFlexibleContexts"+    , "-XFlexibleInstances"+    , "-XFunctionalDependencies"+    , "-XGADTs"+    , "-XGeneralizedNewtypeDeriving"+    , "-XInstanceSigs"+    , "-XKindSignatures"+    , "-XLambdaCase"+    , "-XMonadFailDesugaring"+    , "-XMultiParamTypeClasses"+    , "-XMultiWayIf"+    , "-XNamedFieldPuns"+    , "-XOverloadedStrings"+    , "-XPartialTypeSignatures"+    , "-XPatternGuards"+    , "-XPolyKinds"+    , "-XRankNTypes"+    , "-XRecordWildCards"+    , "-XScopedTypeVariables"+    , "-XStandaloneDeriving"+    , "-XTupleSections"+    , "-XTypeApplications"+    , "-XTypeFamilies"+    , "-XTypeSynonymInstances"+    , "-XViewPatterns"+    ]