Some lint improvements

casing.cabal

@@ -34,7 +34,9 @@ test-suite tests
   hs-source-dirs: tests
   type: exitcode-stdio-1.0
   default-language: Haskell2010
-  build-depends: base >=4.8 && <5
-               , casing
-               , tasty
-               , tasty-hunit
+  build-depends:
+      base >=4.8 && <5
+    , casing
+    , tasty
+    , tasty-hunit
+    , tasty-quickcheck

src/Text/Casing.hs

@@ -1,5 +1,4 @@
-{-# LANGUAGE GeneralizedNewtypeDeriving #-}
-{-# LANGUAGE DeriveTraversable #-}
+{-# LANGUAGE BangPatterns, DeriveTraversable, GeneralizedNewtypeDeriving #-}
 -- | Conversions between several common identifier casing conventions:
 --
 -- - @PascalCase@ - no spacing between words, first letter in word is
@@ -41,49 +40,45 @@ Identifier (..)
 where
 
 import Data.Char
-import Data.List (intersperse)
+import Data.Semigroup(Semigroup((<>)))
+import Data.List (intercalate)
 import Data.List.Split (wordsBy)
 import Control.Applicative
 
 -- | An opaque type that represents a parsed identifier.
 newtype Identifier a = Identifier { unIdentifier :: [a] }
     deriving (Monad, Functor, Applicative, Show, Foldable, Traversable, Eq)
 
+instance Semigroup (Identifier a) where
+    Identifier a <> Identifier b = Identifier (a <> b)
+
 wordCase :: String -> String
 wordCase "" = ""
 wordCase (x:xs) = toUpper x : map toLower xs
 
 -- | Convert from "humped" casing (@camelCase@ or @PascalCase@)
 fromHumps :: String -> Identifier String
-fromHumps = Identifier . go
-    where
-        go "" = [""]
-        go (x:[]) = [x:[]]
-        go xxs@(x:xs)
-          | isUpper x =
-              let lhs = takeWhile isUpper xxs
-                  rhs = dropWhile isUpper xxs
-              in
-              if null rhs then
-                [lhs]
-              else
-                let curLen = length lhs - 1
-                    cur = take curLen lhs
-                    rec = go rhs
-                    nxt = drop curLen lhs ++ concat (take 1 rec)
-                    rem = drop 1 rec
-                    curL = if null cur then [] else [cur]
-                    nxtL = if null nxt then [] else [nxt]
-                in curL ++ nxtL ++ rem
-
-          | otherwise =
-              let cur = takeWhile (not . isUpper) xxs
-                  rem = dropWhile (not . isUpper) xxs
-              in
-              if null rem then
-                [cur]
-              else
-                cur:go rem
+fromHumps = Identifier . _fromHumps
+
+_fromHumps :: String -> [String]
+_fromHumps "" = [""]
+_fromHumps c = _fromHumps' c
+
+_unsnoc :: [a] -> a -> ([a], a)
+_unsnoc [] x = ([], x)
+_unsnoc (y:ys) x = let !(za, zb) = _unsnoc ys y in (x:za, zb)
+
+_fromHumps' :: String -> [String]
+_fromHumps' [] = []
+_fromHumps' ca@(c:cs)
+    | isUpper c = go (span isUpper cs)
+    | otherwise = let (ba, bb) = break isUpper cs in (c:ba) : _fromHumps' bb
+    where go (_,[]) = [ca]
+          go (ls, rs) = addlsa ((l:y) : ys)
+              where !(lsa, l) = _unsnoc ls c
+                    !(y:ys) = _fromHumps' rs
+                    addlsa | null lsa = id
+                           | otherwise = (lsa :)
 
 fromWords :: String -> Identifier String
 fromWords = Identifier . words
@@ -102,20 +97,20 @@ fromAny str = fromHumps str >>= fromKebab >>= fromSnake >>= fromWords
 
 -- | To @PascalCase@
 toPascal :: Identifier String -> String
-toPascal = concat . map wordCase . unIdentifier
+toPascal = concatMap wordCase . unIdentifier
 
 -- | To @camelCase@
 toCamel :: Identifier String -> String
 toCamel (Identifier []) = ""
-toCamel (Identifier (x:xs)) = concat $ map toLower x:map wordCase xs
+toCamel (Identifier (x:xs)) = map toLower x ++ concatMap wordCase xs
 
 -- | To @kebab-case@
 toKebab :: Identifier String -> String
-toKebab = concat . intersperse "-" . map (map toLower) . unIdentifier
+toKebab = intercalate "-" . map (map toLower) . unIdentifier
 
 -- | To @snake_Case@
 toSnake :: Identifier String -> String
-toSnake = concat . intersperse "_" . unIdentifier
+toSnake = intercalate "_" . unIdentifier
 
 -- | To @quiet_snake_case@
 toQuietSnake :: Identifier String -> String
@@ -159,5 +154,5 @@ wordify = toWords . fromAny
 
 -- | Drop the first word from a parsed identifier. Typical usage is between
 -- parsing and writing, e.g.: @toKebab . dropPrefix . fromAny $ "strHelloWorld" == "hello-world"@
-dropPrefix :: Identifier String -> Identifier String
-dropPrefix = Identifier . drop 1 . unIdentifier
+dropPrefix :: Identifier [a] -> Identifier [a]
+dropPrefix = fmap (drop 1)