In [1]:
    
import Data.List (group, foldl')
    
In [2]:
    
compress :: String -> String
compress xs
    | length compressedString < length xs = compressedString
    | otherwise = xs
        where compressedString = 
                concatMap (\ys -> head ys : show (length ys)) $ group xs
    
In [3]:
    
compress' :: String -> String
compress' xs = if length result < length xs then result else xs
    where
        countToReversedString = reverse . show
        
        computeState :: Maybe (Char, Int, String) -> Char -> Maybe (Char, Int, String)
        computeState Nothing current = Just (current, 1, [current])
        computeState (Just (previous, count, accumulator)) current
            | previous == current = Just (current, succ count, accumulator)
            | otherwise = Just (current, 1, current : countToReversedString count ++ accumulator)
        result = case foldl' computeState Nothing xs of
            Nothing -> ""
            Just (previous, count, accumulator) -> reverse $ countToReversedString count ++ accumulator
    
In [4]:
    
decompress :: String -> String
decompress xs
    | not isCompressed = xs
    | otherwise = decompress' xs
    where
        isCompressed = any (`elem` ['1'..'9']) xs :: Bool
            
        decompress' :: String -> String
        decompress' "" = ""
        decompress' (chr:ys) = replicate (read count) chr ++ decompress' ys'
            where
                (count, ys') = span (`elem` ['0'..'9']) ys
    
In [5]:
    
compress "aaabcccddddeffaab"
decompress "a3b1c3d4e1f2a2b1"
    
    
    
In [6]:
    
compress "aaaaaaaaaaaaabcdefg"
decompress "a13b1c1d1e1f1g1"
    
    
    
In [7]:
    
import Test.QuickCheck
    
In [8]:
    
newtype CompressibleString = CompressibleString String deriving (Show)
instance Arbitrary CompressibleString where
    arbitrary = CompressibleString <$> concat <$> mapM (listOf . elements) (group ['a'..'z'])
    
In [9]:
    
testRoundtrip :: (String -> String) -> (String -> String) -> CompressibleString -> Bool
testRoundtrip compressFunc decompressFunc (CompressibleString xs) =
    xs == decompressFunc xs' && length xs' <= length xs
        where
            xs' = compressFunc xs
    
In [10]:
    
quickCheck $ testRoundtrip compress decompress
quickCheck $ testRoundtrip compress' decompress