word-count: Add more tests with punctuation

config.json

@@ -148,12 +148,6 @@
       "topics": [
       ]
     },
-    {
-      "slug": "word-count",
-      "difficulty": 4,
-      "topics": [
-      ]
-    },
     {
       "slug": "meetup",
       "difficulty": 4,
@@ -256,6 +250,12 @@
       "topics": [
       ]
     },
+    {
+      "slug": "word-count",
+      "difficulty": 5,
+      "topics": [
+      ]
+    },
     {
       "slug": "binary-search-tree",
       "difficulty": 5,

exercises/word-count/examples/success-newtype/src/WordCount.hs

@@ -2,24 +2,27 @@
 
 module WordCount (wordCount) where
 
-import Prelude hiding (null)
+import Prelude hiding (head, init, null, tail)
 import Data.Char      (isAlphaNum)
-import Data.Text      (Text, null, split, toLower)
+import Data.Text      (Text, head, init, null, split, tail, toLower)
 import Data.MultiSet  (MultiSet, Occur, fromList, fromOccurList, toOccurList)
 
 import qualified GHC.Exts (IsList(..))
 
 wordCount :: Text -> Bag Text
 wordCount = Bag
           . fromList
-          . map toLower
-          . wordsBy (not . isAlphaNum)
+          . map (stripQuote . toLower)
+          . wordsBy (\c -> not (isAlphaNum c) && c /= '\'')
 
 -- The `text` package misses this function that
 -- exists in package `split`, but works on lists.
 wordsBy :: (Char -> Bool) -> Text -> [Text]
 wordsBy p = filter (not . null) . split p
 
+stripQuote :: Text -> Text
+stripQuote t = if head t == '\'' then init (tail t) else t
+
 -- MultiSet is not an instance of `IsList`, so we create
 -- a newtype to wrap it, avoiding an orphan instance.
 newtype Bag a = Bag { toMultiSet :: MultiSet a }

exercises/word-count/examples/success-simple/src/WordCount.hs

@@ -9,5 +9,9 @@ wordCount :: String -> [(String, Int)]
 wordCount = map (head &&& length)
           . group
           . sort
-          . map (map toLower)
-          . wordsBy (not . isAlphaNum)
+          . map (stripQuote . map toLower)
+          . wordsBy (\c -> not (isAlphaNum c) && c /= '\'')
+
+stripQuote :: String -> String
+stripQuote ('\'':t) = init t
+stripQuote s = s

exercises/word-count/test/Tests.hs

@@ -30,7 +30,7 @@ specs = describe "word-count" $
                    . fromList
                    $ input
 
--- Test cases adapted from `exercism/x-common/word-count.json` on 2016-07-26.
+-- Test cases adapted from `exercism/x-common/word-count` on 2016-11-06.
 
 data Case = Case { description :: String
                  , input       :: String
@@ -56,6 +56,18 @@ cases = [ Case { description = "count one word"
                                , ("red" , 1)
                                , ("blue", 1) ]
                }
+        , Case { description = "handles cramped lists"
+               , input       = "one,two,three"
+               , expected    = [ ("one"  , 1)
+                               , ("two"  , 1)
+                               , ("three", 1) ]
+               }
+        , Case { description = "handles expanded lists"
+               , input       = "one,\ntwo,\nthree"
+               , expected    = [ ("one"  , 1)
+                               , ("two"  , 1)
+                               , ("three", 1) ]
+               }
         , Case { description = "ignore punctuation"
                , input       = "car : carpet as java : javascript!!&@$%^&"
                , expected    = [ ("car"       , 1)
@@ -75,4 +87,21 @@ cases = [ Case { description = "count one word"
                , expected    = [ ("go"  , 3)
                                , ("stop", 2) ]
                }
+        , Case { description = "with apostrophes"
+               , input       = "First: don't laugh. Then: don't cry."
+               , expected    = [ ("first", 1)
+                               , ("don't", 2)
+                               , ("laugh", 1)
+                               , ("then" , 1)
+                               , ("cry"  , 1) ]
+               }
+        , Case { description = "with quotations"
+               , input       = "Joe can't tell between 'large' and large."
+               , expected    = [ ("joe"    , 1)
+                               , ("can't"  , 1)
+                               , ("tell"   , 1)
+                               , ("between", 1)
+                               , ("large"  , 2)
+                               , ("and"    , 1) ]
+               }
         ]