diff --git a/api-tests/APITests.hs b/api-tests/APITests.hs deleted file mode 100644 --- a/api-tests/APITests.hs +++ /dev/null @@ -1,51 +0,0 @@ -{-# 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" diff --git a/api-tests/Main.hs b/api-tests/Main.hs new file mode 100644 --- /dev/null +++ b/api-tests/Main.hs @@ -0,0 +1,50 @@ +module Main (main) where + +import qualified Cases +import Test.Hspec +import Prelude + +main :: IO () +main = hspec do + it "spinalizeCamelCase" do + shouldBe "abc-def" $ Cases.spinalize "abcDef" + shouldBe "abc-def" $ Cases.spinalize "abcDEF" + shouldBe "my-html-processor" $ Cases.spinalize "myHTMLProcessor" + + it "spinalizeSymbols" do + shouldBe "abc-def" $ Cases.spinalize "abc_def" + shouldBe "abc-def" $ Cases.spinalize "abc-def" + shouldBe "abc-def" $ Cases.spinalize "abc/def" + shouldBe "abc-def" $ Cases.spinalize "abc,def" + shouldBe "abc-def" $ Cases.spinalize "abc.def" + shouldBe "abc-def" $ Cases.spinalize "abc:def" + + it "spinalizeMultipleDelimiters" do + shouldBe "abc-def" $ Cases.spinalize "abc_-:,/def" + shouldBe "abc-def" $ Cases.spinalize "abc /-def" + + it "spinalizeSpaces" do + shouldBe "abc-def" $ Cases.spinalize "abc def" + shouldBe "abc-def" $ Cases.spinalize "abc\ndef" + shouldBe "abc-def" $ Cases.spinalize "abc\rdef" + shouldBe "abc-def" $ Cases.spinalize "abc\r\n\rdef" + shouldBe "abc-def" $ Cases.spinalize "abc\tdef" + shouldBe "abc-def" $ Cases.spinalize "abc def" + + it "spinalizeTrimming" do + shouldBe "abc-def" $ Cases.spinalize " abc def " + shouldBe "abc-def" $ Cases.spinalize "/abc/def/" + + it "spinalizeNumbers" do + shouldBe "abc-12" $ Cases.spinalize "abc12" + + it "spinalizeUnicode" do + shouldBe "ёжик-лижет-мёд" $ Cases.spinalize "Ёжик лижет мёд." + + it "snakify" do + shouldBe "ёжик_лижет_мёд" $ Cases.snakify "Ёжик лижет мёд." + + it "camelize" do + shouldBe "abcDef" $ Cases.camelize "abc-def" + shouldBe "AbcDef" $ Cases.camelize "Abc-def" + shouldBe "parseDbmXml" $ Cases.camelize "parse DBM XML" diff --git a/benchmark/Benchmark.hs b/benchmark/Benchmark.hs --- a/benchmark/Benchmark.hs +++ b/benchmark/Benchmark.hs @@ -1,13 +1,12 @@ module Main where -import Prelude -import Gauge.Main import qualified Cases as A +import Criterion.Main import qualified Data.Text as B - +import Prelude +main :: IO () main = - defaultMain $ - [ - bench "camelize" $ nf A.camelize $! B.replicate 100 "Abc 123 / dsf asdf ;lkj. " - ] + defaultMain + $ [ bench "camelize" $ nf A.camelize $! B.replicate 100 "Abc 123 / dsf asdf ;lkj. " + ] diff --git a/cases.cabal b/cases.cabal --- a/cases.cabal +++ b/cases.cabal @@ -1,93 +1,93 @@ -name: - cases -version: - 0.1.4.2 -synopsis: - A converter for spinal, snake and camel cases +cabal-version: 3.0 +name: cases +version: 0.1.4.3 +synopsis: A converter for spinal, snake and camel cases description: A parser-based converter library for spinal, snake and camel cases. -category: - Text -homepage: - https://github.com/nikita-volkov/cases -bug-reports: - https://github.com/nikita-volkov/cases/issues -author: - Nikita Volkov -maintainer: - Nikita Volkov -copyright: - (c) 2014, Nikita Volkov -license: - MIT -license-file: - LICENSE -build-type: - Simple -cabal-version: - >=1.10 +category: Text +homepage: https://github.com/nikita-volkov/cases +bug-reports: https://github.com/nikita-volkov/cases/issues +author: Nikita Volkov +maintainer: Nikita Volkov +copyright: (c) 2014, Nikita Volkov +license: MIT +license-file: LICENSE + source-repository head - type: - git - location: - git://github.com/nikita-volkov/cases.git + type: git + location: git://github.com/nikita-volkov/cases.git +common base + default-language: Haskell2010 + default-extensions: + NoImplicitPrelude + NoMonomorphismRestriction + Arrows + BangPatterns + BlockArguments + ConstraintKinds + DataKinds + DefaultSignatures + DeriveDataTypeable + DeriveFoldable + DeriveFunctor + DeriveGeneric + DeriveTraversable + EmptyDataDecls + FlexibleContexts + FlexibleInstances + FunctionalDependencies + GADTs + GeneralizedNewtypeDeriving + LambdaCase + LambdaCase + LiberalTypeSynonyms + MagicHash + MultiParamTypeClasses + MultiWayIf + OverloadedStrings + ParallelListComp + PatternGuards + QuasiQuotes + RankNTypes + RecordWildCards + ScopedTypeVariables + StandaloneDeriving + TemplateHaskell + TupleSections + TypeFamilies + TypeOperators + UnboxedTuples + library - hs-source-dirs: - library - exposed-modules: - Cases - other-modules: - Cases.Prelude + import: base + hs-source-dirs: library + exposed-modules: Cases + other-modules: Cases.Prelude build-depends: - attoparsec >=0.13 && <0.15, - base >=4.11 && <5, - text >=1 && <3 - default-extensions: - Arrows, BangPatterns, ConstraintKinds, DataKinds, DefaultSignatures, DeriveDataTypeable, DeriveFoldable, DeriveFunctor, DeriveGeneric, DeriveTraversable, EmptyDataDecls, FlexibleContexts, FlexibleInstances, FunctionalDependencies, GADTs, GeneralizedNewtypeDeriving, LambdaCase, LiberalTypeSynonyms, MagicHash, MultiParamTypeClasses, MultiWayIf, NoImplicitPrelude, NoMonomorphismRestriction, OverloadedStrings, PatternGuards, ParallelListComp, QuasiQuotes, RankNTypes, RecordWildCards, ScopedTypeVariables, StandaloneDeriving, TemplateHaskell, TupleSections, TypeFamilies, TypeOperators, UnboxedTuples - default-language: - Haskell2010 + , attoparsec >=0.13 && <0.15 + , base >=4.11 && <5 + , text >=1 && <3 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" + import: base + type: exitcode-stdio-1.0 + hs-source-dirs: api-tests + main-is: Main.hs + ghc-options: -threaded -with-rtsopts=-N build-depends: - cases, - HTF >=0.14 && <0.15, - HUnit, - QuickCheck, - rerebase ==1.* - default-extensions: - Arrows, BangPatterns, ConstraintKinds, DataKinds, DefaultSignatures, DeriveDataTypeable, DeriveFoldable, DeriveFunctor, DeriveGeneric, DeriveTraversable, EmptyDataDecls, FlexibleContexts, FlexibleInstances, FunctionalDependencies, GADTs, GeneralizedNewtypeDeriving, LambdaCase, LiberalTypeSynonyms, MagicHash, MultiParamTypeClasses, MultiWayIf, NoImplicitPrelude, NoMonomorphismRestriction, OverloadedStrings, PatternGuards, ParallelListComp, QuasiQuotes, RankNTypes, RecordWildCards, ScopedTypeVariables, StandaloneDeriving, TemplateHaskell, TupleSections, TypeFamilies, TypeOperators, UnboxedTuples - default-language: - Haskell2010 + , cases + , hspec >=2.11 && <3 + , rerebase >=1 && <2 benchmark benchmark - type: - exitcode-stdio-1.0 - hs-source-dirs: - benchmark - main-is: - Benchmark.hs - ghc-options: - -O2 - -threaded - "-with-rtsopts=-N" + import: base + type: exitcode-stdio-1.0 + hs-source-dirs: benchmark + main-is: Benchmark.hs + ghc-options: -O2 -threaded -with-rtsopts=-N build-depends: - cases, - gauge >=0.2.5 && <0.3, - mwc-random >=0.14 && <0.16, - rerebase ==1.* - default-extensions: - Arrows, BangPatterns, ConstraintKinds, DataKinds, DefaultSignatures, DeriveDataTypeable, DeriveFoldable, DeriveFunctor, DeriveGeneric, DeriveTraversable, EmptyDataDecls, FlexibleContexts, FlexibleInstances, FunctionalDependencies, GADTs, GeneralizedNewtypeDeriving, LambdaCase, LiberalTypeSynonyms, MagicHash, MultiParamTypeClasses, MultiWayIf, NoImplicitPrelude, NoMonomorphismRestriction, OverloadedStrings, PatternGuards, ParallelListComp, QuasiQuotes, RankNTypes, RecordWildCards, ScopedTypeVariables, StandaloneDeriving, TemplateHaskell, TupleSections, TypeFamilies, TypeOperators, UnboxedTuples - default-language: - Haskell2010 + , cases + , criterion >=1.6.3 && <2 + , rerebase >=1 && <2 diff --git a/library/Cases.hs b/library/Cases.hs --- a/library/Cases.hs +++ b/library/Cases.hs @@ -1,37 +1,37 @@ module Cases -( - -- * Processor - process, - -- ** Case Transformers - CaseTransformer, - lower, - upper, - title, - -- ** Delimiters - Delimiter, - spinal, - snake, - whitespace, - camel, - -- * Default Processors - spinalize, - snakify, - camelize, -) + ( -- * Processor + process, + + -- ** Case Transformers + CaseTransformer, + lower, + upper, + title, + + -- ** Delimiters + Delimiter, + spinal, + snake, + whitespace, + camel, + + -- * Default Processors + spinalize, + snakify, + camelize, + ) where import Cases.Prelude hiding (Word) import qualified Data.Attoparsec.Text as A import qualified Data.Text as T - -- * Part -------------------------- -- | A parsed info and a text of a part. -data Part = - Word Case T.Text | - Digits T.Text +data Part + = Word Case T.Text + | Digits T.Text data Case = Title | Upper | Lower @@ -40,26 +40,26 @@ Word _ t -> t Digits t -> t - -- * Parsers -------------------------- upperParser :: A.Parser Part -upperParser = Word Upper <$> T.pack <$> A.many1 char where - char = do - c <- A.satisfy isUpper - ok <- maybe True (not . isLower) <$> A.peekChar - if ok - then return c - else empty +upperParser = Word Upper <$> T.pack <$> A.many1 char + where + char = do + c <- A.satisfy isUpper + ok <- maybe True (not . isLower) <$> A.peekChar + if ok + then return c + else empty lowerParser :: A.Parser Part lowerParser = Word Lower <$> (A.takeWhile1 isLower) titleParser :: A.Parser Part -titleParser = Word Title <$> (T.cons <$> headChar <*> remainder) where - headChar = A.satisfy isUpper - remainder = A.takeWhile1 isLower +titleParser = Word Title <$> (T.cons <$> headChar <*> remainder) + where + headChar = A.satisfy isUpper + remainder = A.takeWhile1 isLower digitsParser :: A.Parser Part digitsParser = Digits <$> (A.takeWhile1 isDigit) @@ -69,119 +69,120 @@ -- | -- 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) - +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 T.Text) spinal :: Delimiter -spinal = - (. partToText) . - fmap Just . - maybe id (\l r -> l <> "-" <> r) +spinal = + (. partToText) + . fmap Just + . maybe id (\l r -> l <> "-" <> r) snake :: Delimiter -snake = - (. partToText) . - fmap Just . - maybe id (\l r -> l <> "_" <> r) +snake = + (. partToText) + . fmap Just + . maybe id (\l r -> l <> "_" <> r) whitespace :: Delimiter -whitespace = - (. partToText) . - fmap Just . - maybe id (\l r -> l <> " " <> r) +whitespace = + (. partToText) + . fmap Just + . maybe id (\l r -> l <> " " <> r) camel :: Delimiter -camel = - fmap Just . - maybe partToText (\l r -> l <> partToText (title r)) - +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 -> T.uncons t |> \case - Nothing -> t - Just (h, t) -> T.cons (toLower h) t - Upper -> T.toLower t - Lower -> t + Word c t -> Word Lower t' + where + t' = case c of + Title -> + T.uncons t |> \case + Nothing -> t + Just (h, t) -> T.cons (toLower h) t + Upper -> T.toLower t + Lower -> t p -> p upper :: CaseTransformer upper = \case - Word c t -> Word Upper t' where - t' = case c of - Title -> T.uncons t |> \case - Nothing -> t - Just (h, t) -> T.cons h (T.toUpper t) - Upper -> t - Lower -> T.toUpper t + Word c t -> Word Upper t' + where + t' = case c of + Title -> + T.uncons t |> \case + Nothing -> t + Just (h, t) -> T.cons h (T.toUpper t) + Upper -> t + Lower -> T.toUpper t p -> p title :: CaseTransformer title = \case - Word c t -> Word Title t' where - t' = case c of - Title -> t - Upper -> T.uncons t |> \case - Nothing -> t - Just (h, t) -> T.cons (toUpper h) (T.toLower t) - Lower -> T.uncons t |> \case - Nothing -> t - Just (h, t) -> T.cons (toUpper h) t + Word c t -> Word Title t' + where + t' = case c of + Title -> t + Upper -> + T.uncons t |> \case + Nothing -> t + Just (h, t) -> T.cons (toUpper h) (T.toLower t) + Lower -> + T.uncons t |> \case + Nothing -> t + Just (h, t) -> T.cons (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 -> T.Text -> T.Text -process tr fo = - fromMaybe "" . - either (error . ("Parse failure: " <>)) id . - A.parseOnly (partsParser $ (. tr) . fo) +process tr fo = + fromMaybe "" + . either (error . ("Parse failure: " <>)) id + . A.parseOnly (partsParser $ (. tr) . fo) -- | -- Transform an arbitrary text into a lower spinal case. --- +-- -- Same as @('process' 'lower' 'spinal')@. spinalize :: T.Text -> T.Text spinalize = process lower spinal -- | -- Transform an arbitrary text into a lower snake case. --- +-- -- Same as @('process' 'lower' 'snake')@. snakify :: T.Text -> T.Text snakify = process lower snake -- | --- Transform an arbitrary text into a camel case, +-- Transform an arbitrary text into a camel case, -- while preserving the case of the first character. --- +-- -- Same as @('process' 'id' 'camel')@. camelize :: T.Text -> T.Text camelize = process id camel - diff --git a/library/Cases/Prelude.hs b/library/Cases/Prelude.hs --- a/library/Cases/Prelude.hs +++ b/library/Cases/Prelude.hs @@ -1,25 +1,21 @@ module Cases.Prelude -( - module Exports, - - (?:), - (|>), - (<|), - (|$>), -) + ( module Exports, + (?:), + (|>), + (<|), + (|$>), + ) where --- base -------------------------- -import Control.Applicative as Exports hiding (WrappedArrow(..)) +import Control.Applicative as Exports hiding (WrappedArrow (..)) import Control.Arrow as Exports hiding (first, second) import Control.Category as Exports import Control.Concurrent as Exports import Control.Exception as Exports -import Control.Monad as Exports hiding (fail, mapM_, sequence_, forM_, msum, mapM, sequence, forM) -import Control.Monad.IO.Class as Exports +import Control.Monad as Exports hiding (fail, forM, forM_, mapM, mapM_, msum, sequence, sequence_) import Control.Monad.Fail as Exports import Control.Monad.Fix as Exports hiding (fix) +import Control.Monad.IO.Class as Exports import Control.Monad.ST as Exports import Data.Bifunctor as Exports import Data.Bits as Exports @@ -33,20 +29,20 @@ import Data.Fixed as Exports import Data.Foldable as Exports hiding (toList) import Data.Function as Exports hiding (id, (.)) -import Data.Functor as Exports +import Data.Functor as Exports hiding (unzip) import Data.Functor.Compose as Exports -import Data.Int as Exports import Data.IORef as Exports +import Data.Int as Exports import Data.Ix as Exports -import Data.List as Exports hiding (sortOn, isSubsequenceOf, uncons, concat, foldr, foldl1, maximum, minimum, product, sum, all, and, any, concatMap, elem, foldl, foldr1, notElem, or, find, maximumBy, minimumBy, mapAccumL, mapAccumR, foldl') -import Data.List.NonEmpty as Exports (NonEmpty(..)) +import Data.List as Exports hiding (all, and, any, concat, concatMap, elem, find, foldl, foldl', foldl1, foldr, foldr1, isSubsequenceOf, mapAccumL, mapAccumR, maximum, maximumBy, minimum, minimumBy, notElem, or, product, sortOn, sum, uncons) +import Data.List.NonEmpty as Exports (NonEmpty (..)) import Data.Maybe as Exports import Data.Monoid as Exports hiding (Alt, (<>)) import Data.Ord as Exports import Data.Proxy as Exports import Data.Ratio as Exports -import Data.Semigroup as Exports hiding (First(..), Last(..)) import Data.STRef as Exports +import Data.Semigroup as Exports hiding (First (..), Last (..)) import Data.String as Exports import Data.Traversable as Exports import Data.Tuple as Exports @@ -59,13 +55,12 @@ import Foreign.Ptr as Exports import Foreign.StablePtr as Exports import Foreign.Storable as Exports -import GHC.Conc as Exports hiding (orElse, withMVar, threadWaitWriteSTM, threadWaitWrite, threadWaitReadSTM, threadWaitRead) -import GHC.Exts as Exports (IsList(..), lazy, inline, sortWith, groupWith) +import GHC.Conc as Exports hiding (orElse, threadWaitRead, threadWaitReadSTM, threadWaitWrite, threadWaitWriteSTM, withMVar) +import GHC.Exts as Exports (IsList (..), groupWith, inline, lazy, sortWith) import GHC.Generics as Exports (Generic) import GHC.IO.Exception as Exports import GHC.OverloadedLabels as Exports import Numeric as Exports -import Prelude as Exports hiding (Read, fail, concat, foldr, mapM_, sequence_, foldl1, maximum, minimum, product, sum, all, and, any, concatMap, elem, foldl, foldr1, notElem, or, mapM, sequence, id, (.)) import System.Environment as Exports import System.Exit as Exports import System.IO as Exports (Handle, hClose) @@ -75,10 +70,10 @@ import System.Mem.StableName as Exports import System.Timeout as Exports import Text.ParserCombinators.ReadP as Exports (ReadP, readP_to_S, readS_to_P) -import Text.ParserCombinators.ReadPrec as Exports (ReadPrec, readPrec_to_P, readP_to_Prec, readPrec_to_S, readS_to_Prec) -import Text.Printf as Exports (printf, hPrintf) +import Text.ParserCombinators.ReadPrec as Exports (ReadPrec, readP_to_Prec, readPrec_to_P, readPrec_to_S, readS_to_Prec) +import Text.Printf as Exports (hPrintf, printf) import Unsafe.Coerce as Exports - +import Prelude as Exports hiding (Read, all, and, any, concat, concatMap, elem, fail, foldl, foldl1, foldr, foldr1, id, mapM, mapM_, maximum, minimum, notElem, or, product, sequence, sequence_, sum, (.)) (?:) :: Maybe a -> a -> a maybeA ?: b = fromMaybe b maybeA @@ -92,10 +87,11 @@ 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: >>=, >>>, |>. +(|$>) :: (Functor f) => f a -> (a -> b) -> f b (|$>) = flip fmap {-# INLINE (|$>) #-}