cases (empty) → 0.1.0

raw patch · 7 files changed

+575/−0 lines, 7 filesdep +HTFdep +HUnitdep +QuickChecksetup-changed

Dependencies added: HTF, HUnit, QuickCheck, attoparsec, base, cases, criterion-plus, loch-th, mtl, mwc-random, placeholders, text

Files

LICENSE +22/−0
Setup.hs +2/−0
api-tests/APITests.hs +51/−0
benchmark/Benchmark.hs +13/−0
cases.cabal +214/−0
library/Cases.hs +181/−0
library/Cases/Prelude.hs +92/−0

+ LICENSE view

@@ -0,0 +1,22 @@+Copyright (c) 2014, Nikita Volkov++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

+ api-tests/APITests.hs view

@@ -0,0 +1,51 @@+{-# OPTIONS_GHC -F -pgmF htfpp #-}++import Prelude+import Test.Framework+import qualified Cases++main = htfMain $ htf_thisModulesTests+++test_spinalizeCamelCase = do+  assertEqual "abc-def" $ Cases.spinalize "abcDef"+  assertEqual "abc-def" $ Cases.spinalize "abcDEF"+  assertEqual "my-html-processor" $ Cases.spinalize "myHTMLProcessor"++test_spinalizeSymbols = do+  assertEqual "abc-def" $ Cases.spinalize "abc_def"+  assertEqual "abc-def" $ Cases.spinalize "abc-def"+  assertEqual "abc-def" $ Cases.spinalize "abc/def"+  assertEqual "abc-def" $ Cases.spinalize "abc,def"+  assertEqual "abc-def" $ Cases.spinalize "abc.def"+  assertEqual "abc-def" $ Cases.spinalize "abc:def"++test_spinalizeMultipleDelimiters = do+  assertEqual "abc-def" $ Cases.spinalize "abc_-:,/def"+  assertEqual "abc-def" $ Cases.spinalize "abc /-def"+    +test_spinalizeSpaces = do+  assertEqual "abc-def" $ Cases.spinalize "abc def"+  assertEqual "abc-def" $ Cases.spinalize "abc\ndef"+  assertEqual "abc-def" $ Cases.spinalize "abc\rdef"+  assertEqual "abc-def" $ Cases.spinalize "abc\r\n\rdef"+  assertEqual "abc-def" $ Cases.spinalize "abc\tdef"+  assertEqual "abc-def" $ Cases.spinalize "abc  def"++test_spinalizeTrimming = do+  assertEqual "abc-def" $ Cases.spinalize " abc def "+  assertEqual "abc-def" $ Cases.spinalize "/abc/def/"++test_spinalizeNumbers = do+  assertEqual "abc-12" $ Cases.spinalize "abc12"++test_spinalizeUnicode = do+  assertEqual "ёжик-лижет-мёд" $ Cases.spinalize "Ёжик лижет мёд."++test_snakify = do+  assertEqual "ёжик_лижет_мёд" $ Cases.snakify "Ёжик лижет мёд."++test_camelize = do+  assertEqual "abcDef" $ Cases.camelize "abc-def"+  assertEqual "AbcDef" $ Cases.camelize "Abc-def"+  assertEqual "parseDbmXml" $ Cases.camelize "parse DBM XML"

+ benchmark/Benchmark.hs view

@@ -0,0 +1,13 @@++import Prelude+import Cases+import qualified CriterionPlus as C+import qualified Data.Text as Text++main = do+  C.benchmark $ do++    C.standoff "" $ do+      let !text = Text.replicate 100 "Abc 123 / dsf asdf ;lkj. "+      C.subject "camelize" $ do+        C.nfIO $ return $ camelize text

+ cases.cabal view

@@ -0,0 +1,214 @@+name:+  cases+version:+  0.1.0+synopsis:+  A converter for spinal, snake and camel case+description:+  A parser-based converter library for spinal, snake and camel case.+category:+  Text+homepage:+  https://github.com/nikita-volkov/cases +bug-reports:+  https://github.com/nikita-volkov/cases/issues +author:+  Nikita Volkov <nikita.y.volkov@mail.ru>+maintainer:+  Nikita Volkov <nikita.y.volkov@mail.ru>+copyright:+  (c) 2014, Nikita Volkov+license:+  MIT+license-file:+  LICENSE+build-type:+  Simple+cabal-version:+  >=1.10+++source-repository head+  type:+    git+  location:+    git://github.com/nikita-volkov/cases.git+++library+  hs-source-dirs:+    library+  other-modules:+    Cases.Prelude+  exposed-modules:+    Cases+  build-depends:+    -- data:+    attoparsec >= 0.10 && < 0.12,+    text,+    -- control:+    mtl,+    -- debugging:+    loch-th == 0.2.*,+    placeholders == 0.1.*,+    -- general:+    base >= 4.5 && < 5+  default-extensions:+    Arrows+    BangPatterns+    ConstraintKinds+    DataKinds+    DefaultSignatures+    DeriveDataTypeable+    DeriveFunctor+    DeriveGeneric+    EmptyDataDecls+    FlexibleContexts+    FlexibleInstances+    FunctionalDependencies+    GADTs+    GeneralizedNewtypeDeriving+    ImpredicativeTypes+    LambdaCase+    LiberalTypeSynonyms+    MultiParamTypeClasses+    MultiWayIf+    NoImplicitPrelude+    NoMonomorphismRestriction+    OverloadedStrings+    PatternGuards+    ParallelListComp+    QuasiQuotes+    RankNTypes+    RecordWildCards+    ScopedTypeVariables+    StandaloneDeriving+    TemplateHaskell+    TupleSections+    TypeFamilies+    TypeOperators+  default-language:+    Haskell2010+++test-suite api-tests+  type:             +    exitcode-stdio-1.0+  hs-source-dirs:   +    api-tests+  main-is:          +    APITests.hs+  ghc-options:+    -O2+    -threaded+    "-with-rtsopts=-N"+  build-depends:+    -- testing:+    cases,+    QuickCheck,+    HUnit,+    HTF == 0.11.*,+    -- data:+    text,+    -- debugging:+    loch-th == 0.2.*,+    placeholders == 0.1.*,+    -- general:+    base >= 4.5 && < 5+  default-extensions:+    Arrows+    BangPatterns+    ConstraintKinds+    DataKinds+    DefaultSignatures+    DeriveDataTypeable+    DeriveFunctor+    DeriveGeneric+    EmptyDataDecls+    FlexibleContexts+    FlexibleInstances+    FunctionalDependencies+    GADTs+    GeneralizedNewtypeDeriving+    ImpredicativeTypes+    LambdaCase+    LiberalTypeSynonyms+    MultiParamTypeClasses+    MultiWayIf+    NoImplicitPrelude+    NoMonomorphismRestriction+    OverloadedStrings+    PatternGuards+    ParallelListComp+    QuasiQuotes+    RankNTypes+    RecordWildCards+    ScopedTypeVariables+    StandaloneDeriving+    TemplateHaskell+    TupleSections+    TypeFamilies+    TypeOperators+  default-language:+    Haskell2010+++benchmark benchmark+  type:             +    exitcode-stdio-1.0+  hs-source-dirs:   +    benchmark+  main-is:      +    Benchmark.hs+  ghc-options:+    -O2+    -threaded+    "-with-rtsopts=-N"+  build-depends:+    cases,+    mwc-random == 0.13.*,+    -- benchmarking:+    criterion-plus == 0.1.*,+    -- data:+    text,+    -- debugging:+    loch-th == 0.2.*,+    placeholders == 0.1.*,+    -- +    base >= 4.5 && < 5+  default-extensions:+    Arrows+    BangPatterns+    ConstraintKinds+    DataKinds+    DefaultSignatures+    DeriveDataTypeable+    DeriveFunctor+    DeriveGeneric+    EmptyDataDecls+    FlexibleContexts+    FlexibleInstances+    FunctionalDependencies+    GADTs+    GeneralizedNewtypeDeriving+    ImpredicativeTypes+    LambdaCase+    LiberalTypeSynonyms+    MultiParamTypeClasses+    MultiWayIf+    NoImplicitPrelude+    NoMonomorphismRestriction+    OverloadedStrings+    PatternGuards+    QuasiQuotes+    RankNTypes+    RecordWildCards+    ScopedTypeVariables+    StandaloneDeriving+    TemplateHaskell+    TupleSections+    TypeFamilies+    TypeOperators+  default-language:+    Haskell2010+

+ library/Cases.hs view

@@ -0,0 +1,181 @@+module Cases+(+  -- * Processor+  process,+  -- ** Case Transformers+  CaseTransformer,+  lower,+  upper,+  title,+  -- ** Delimiters+  Delimiter,+  spinal,+  snake,+  camel,+  -- * Default Processors+  spinalize,+  snakify,+  camelize,+)+where++import Cases.Prelude hiding (Word)+import qualified Data.Attoparsec.Text as A+import qualified Data.Text as TS+import qualified Data.Char as C+++-- * Part+-------------------------++-- | A parsed info and a text of a part.+data Part = +  Word Case TS.Text |+  Digits TS.Text++data Case = Title | Upper | Lower++partToText :: Part -> TS.Text+partToText = \case+  Word _ t -> t+  Digits t -> t+++-- * Parsers+-------------------------++upperParser :: A.Parser Part+upperParser = Word Upper <$> TS.pack <$> A.many1 char where+  char = do+    c <- A.satisfy C.isUpper+    ok <- maybe True (not . C.isLower) <$> A.peekChar+    if ok+      then return c+      else empty++lowerParser :: A.Parser Part+lowerParser = Word Lower <$> (A.takeWhile1 C.isLower)++titleParser :: A.Parser Part+titleParser = Word Title <$> (TS.cons <$> headChar <*> remainder) where+  headChar = A.satisfy C.isUpper+  remainder = A.takeWhile1 C.isLower++digitsParser :: A.Parser Part+digitsParser = Digits <$> (A.takeWhile1 C.isDigit)++partParser :: A.Parser Part+partParser = titleParser <|> upperParser <|> lowerParser <|> digitsParser++-- |+-- A parser, which does in-place processing, using the supplied 'Folder'.+partsParser :: Monoid r => Folder r -> A.Parser r+partsParser fold = loop mempty where+  loop r = +    (partParser >>= loop . fold r) <|> +    (A.anyChar *> loop r) <|>+    (A.endOfInput *> pure r)+++-- * Folders+-------------------------++type Folder r = r -> Part -> r++type Delimiter = Folder (Maybe TS.Text)++spinal :: Delimiter+spinal = +  (. partToText) . +  fmap Just . +  maybe id (\l r -> l <> "-" <> r)++snake :: Delimiter+snake = +  (. partToText) . +  fmap Just . +  maybe id (\l r -> l <> "_" <> r)++camel :: Delimiter+camel = +  fmap Just .+  maybe partToText (\l r -> l <> partToText (title r))+++-- * CaseTransformers+-------------------------++type CaseTransformer = Part -> Part++lower :: CaseTransformer+lower = \case+  Word c t -> Word Lower t' where+    t' = case c of+      Title -> TS.uncons t |> \case+        Nothing -> t+        Just (h, t) -> TS.cons (C.toLower h) t+      Upper -> TS.toLower t+      Lower -> t+  p -> p++upper :: CaseTransformer+upper = \case+  Word c t -> Word Upper t' where+    t' = case c of+      Title -> TS.uncons t |> \case+        Nothing -> t+        Just (h, t) -> TS.cons h (TS.toUpper t)+      Upper -> t+      Lower -> TS.toUpper t+  p -> p++title :: CaseTransformer+title = \case+  Word c t -> Word Title t' where+    t' = case c of+      Title -> t+      Upper -> TS.uncons t |> \case+        Nothing -> t  +        Just (h, t) -> TS.cons (C.toUpper h) (TS.toLower t)+      Lower -> TS.uncons t |> \case+        Nothing -> t+        Just (h, t) -> TS.cons (C.toUpper h) t+  p -> p+++-- * API+-------------------------++-- |+-- Extract separate words from an arbitrary text using a smart parser and+-- produce a new text using case transformation and delimiter functions.+-- +-- Note: to skip case transformation use the 'id' function.+process :: CaseTransformer -> Delimiter -> TS.Text -> TS.Text+process tr fo = +  fromMaybe "" .+  either ($bug . ("Parse failure: " <>)) id .+  A.parseOnly (partsParser $ (. tr) . fo)++-- |+-- Transform an arbitrary text into a lower spinal case.+-- +-- Same as @('process' 'lower' 'spinal')@.+spinalize :: TS.Text -> TS.Text+spinalize = process lower spinal++-- |+-- Transform an arbitrary text into a lower snake case.+-- +-- Same as @('process' 'lower' 'snake')@.+snakify :: TS.Text -> TS.Text+snakify = process lower snake++-- |+-- Transform an arbitrary text into a camel case, +-- while preserving the case of the first character.+-- +-- Same as @('process' 'id' 'camel')@.+camelize :: TS.Text -> TS.Text+camelize = process id camel+

+ library/Cases/Prelude.hs view

@@ -0,0 +1,92 @@+module Cases.Prelude+( +  module Exports,++  traceM,+  bug,+  bottom,++  (?:),+  (|>),+  (<|),+  (|$>),+)+where++-- base+-------------------------+import Prelude as Exports hiding (concat, foldr, mapM_, sequence_, foldl1, maximum, minimum, product, sum, all, and, any, concatMap, elem, foldl, foldr1, notElem, or, mapM, sequence, FilePath, id, (.))+import Control.Monad as Exports hiding (mapM_, sequence_, forM_, msum, mapM, sequence, forM)+import Control.Applicative as Exports+import Control.Arrow as Exports hiding (left, right)+import Control.Category as Exports+import Data.Monoid as Exports+import Data.Foldable as Exports+import Data.Traversable as Exports hiding (for)+import Data.Maybe as Exports+import Data.Either as Exports+import Data.List as Exports hiding (concat, foldr, foldl1, maximum, minimum, product, sum, all, and, any, concatMap, elem, foldl, foldr1, notElem, or, find, maximumBy, minimumBy, mapAccumL, mapAccumR, foldl')+import Data.Tuple as Exports+import Data.Function as Exports hiding ((.), id)+import Data.Ord as Exports (Down(..))+import Data.String as Exports+import Data.Int as Exports+import Data.Word as Exports+import Data.Ratio as Exports+import Data.Fixed as Exports+import Data.Ix as Exports+import Data.Data as Exports+import Text.Read as Exports (readMaybe, readEither)+import Control.Exception as Exports hiding (tryJust, try, assert)+import Control.Concurrent as Exports hiding (yield)+import System.Mem as Exports+import System.Mem.StableName as Exports+import System.Timeout as Exports+import System.Exit as Exports+import System.IO.Unsafe as Exports+import System.IO as Exports (Handle, hClose)+import System.IO.Error as Exports+import Unsafe.Coerce as Exports+import GHC.Generics as Exports (Generic)+import GHC.IO.Exception as Exports+import Data.IORef as Exports+import Data.STRef as Exports+import Control.Monad.ST as Exports+import Debug.Trace as Exports hiding (traceM)++-- placeholders+-------------------------+import Development.Placeholders as Exports++-- custom+-------------------------+import qualified Debug.Trace.LocationTH++traceM :: (Monad m) => String -> m ()+traceM s = trace s $ return ()++bug = [e| $(Debug.Trace.LocationTH.failure) . (msg <>) |]+  where+    msg = "A \"cases\" package bug: " :: String++bottom = [e| $bug "Bottom evaluated" |]++(?:) :: Maybe a -> a -> a+maybeA ?: b = fromMaybe b maybeA+{-# INLINE (?:) #-}++(|>) :: a -> (a -> b) -> b+a |> aToB = aToB a+{-# INLINE (|>) #-}++(<|) :: (a -> b) -> a -> b+aToB <| a = aToB a+{-# INLINE (<|) #-}++-- | +-- The following are all the same:+-- fmap f a == f <$> a == a |> fmap f == a |$> f+-- +-- This operator accomodates the left-to-right operators: >>=, >>>, |>.+(|$>) = flip fmap+{-# INLINE (|$>) #-}