rle.hs

import Data.List (group, sort)
import Data.Char (isNumber, isAlpha, toUpper)
import Test.Hspec (hspec, describe, it, shouldBe)
import Test.QuickCheck (Arbitrary, Gen, elements, listOf, arbitrary)
import Test.Hspec.QuickCheck (prop)
import Control.Monad (forM_)
import Data.Functor ((<$>))

-- Main

rle :: String -> String
rle = concatMap encode . group where
  encode cs = head cs : show (length cs)

rld :: String -> String
rld [] = []
rld (c:cs) = let (n,rest) = span isNumber cs
             in  replicate (read n) c ++ rld rest

-- Test

test :: IO()
test = hspec $ do
  describe "rle" $
    forM_ rleTestList $ \((number, (input, expected))) ->
      it (show number ++ ": " ++ input ++ " -> " ++ expected) $
      rle input `shouldBe` expected
  describe "rld" $
    forM_ rleTestList $ \((number, (expected, input))) ->
      it (show number ++ ": " ++ input ++ " -> " ++ expected) $
      rld input `shouldBe` expected
  describe "both rle and rld" $ do
    prop "Sorted Alpha" rleRldSortedAlpha
    prop "Alpha" rleRldAlpha

rleTestList :: [(Int, (String, String))]
rleTestList = zip [1..]
           [("A", "A1")
           ,("AA", "A2")
           ,("AAABBCCC", "A3B2C3")
           ,("AAABBCCCC", "A3B2C4")
           ,("", "")]

newtype UpperString = UpperString { unwrapUpperString :: String }
                    deriving Show

instance Arbitrary UpperString where
    arbitrary = UpperString <$> genUpperString

genUpperChar :: Gen Char
genUpperChar = elements ['A'..'Z']

genUpperString :: Gen String
genUpperString = listOf genUpperChar

rleRldSortedAlpha :: UpperString -> Bool
rleRldSortedAlpha us = let cs = sort (unwrapUpperString us)
                       in  rld (rle cs) == cs

rleRldAlpha :: UpperString -> Bool
rleRldAlpha us = let cs = unwrapUpperString us
                 in  rld (rle cs) == cs