Ninety-Nine Haskell Problems: #8

-- Problem 8: eliminate consecutive duplicates of list elements. If a
-- list contains repeated elements they should be replaced with a
-- single copy of the element. The order of the elements should not be
-- changed.

import Data.List
import qualified Data.Set as Set

main :: IO ()
main = do
  putStrLn "Test strings: "
  mapM_ print $ chunksOfFour testStringList
  putStrLn "\nTested functions validity check: "
  mapM_ (print . testFunction) testFuncList

testFuncList :: (Eq a, Ord a) => [[a] -> [a]]
testFuncList = [one, two, three, four, five, six, seven]

testStringList :: [String]
testStringList = pure (\a b c d -> [a, b, c, d])
  <*> "ab"
  <*> "ab"
  <*> "ab"
  <*> "ab"

testFunction :: (String -> String) -> Bool
testFunction function =
  map function testStringList == map uniq testStringList
  where
    -- uniq from Data.List.Unique is used to produce reference results
    uniq = map head . group

chunksOfFour :: [a] -> [[a]]
chunksOfFour [] = []
chunksOfFour lst = take 4 lst : chunksOfFour (drop 4 lst)

-- Tested functions

one :: Eq a => [a] -> [a]
one [] = []
one [x] = [x]
one (x:y:ys)
  | x == y = one (y : ys)
  | otherwise = x : one (y : ys)

two :: Eq a => [a] -> [a]
two [] = []
two [w] = [w]
two (x:xs) =
  reverse $ foldl (\(y:ys) z -> if y == z then z:ys else z:y:ys) [x] xs

three :: Eq a => [a] -> [a]
three [] = []
three [x] = [x]
three list = let
  lastItem = last list
  in
  foldr (\x (y:ys) ->
           if x == y
           then y:ys
           else x:y:ys) [lastItem] list

four :: Eq a => [a] -> [a]
four [] = []
four list@(x:xs) = x : (zip list xs >>= noDupesTuples)
  where
    noDupesTuples (a, b)
      | a == b = []
      | otherwise = [b]

five :: Eq a => [a] -> [a]
five [] = []
five lst = pure head <*> group lst

six :: Eq a => [a] -> [a]
six [] = []
six lst = concatMap nub (group lst)

seven :: (Eq a, Ord a) => [a] -> [a]
seven [] = []
seven lst = concatMap (Set.toList . Set.fromList) (group lst)

-- Test strings:
-- ["aaaa","aaab","aaba","aabb"]
-- ["abaa","abab","abba","abbb"]
-- ["baaa","baab","baba","babb"]
-- ["bbaa","bbab","bbba","bbbb"]
--
-- Tested functions validity check:
-- True
-- True
-- True
-- True
-- True
-- True
-- True