http://www.haskell.org/haskellwiki/99_questions/11_to_20

RunLength.hs

import Control.Applicative
import Data.List (group)

data RunLength b = Multiple Int b | Single b | Empty deriving (Show, Eq)

encodeModified :: String -> [RunLength Char] -> [RunLength Char]
encodeModified str acc = do
  let rlItem = calcRunlength 0 str
  case fst rlItem of
    "" ->  acc ++ [snd rlItem]
    _ -> encodeModified (fst rlItem) (acc ++ [snd rlItem])
  where
    calcRunlength :: Int -> String -> (String, RunLength Char)
    calcRunlength _ [] = ("", Empty)
    calcRunlength count' (x:[]) =
        if count' == 0
        then ("", Single x)
        else ("", Multiple (count' + 1) x)
    calcRunlength count' (x:y:[])
        | x == y = calcRunlength (count' + 1) [y]
        | count' == 0 = ([y], Single x)
        | otherwise = ([y], Multiple (count' + 1) x)
    calcRunlength count' (x:y:xs)
        | x == y = calcRunlength (count' + 1) (y:xs)
        | count' == 0 = (y:xs, Single x)
        | otherwise = (y:xs, Multiple (count' + 1) x)

{-| encodeModifed Test
  >>> encodeModified "aaabcccd" []
  [Multiple 3 'a',Single 'b',Multiple 3 'c',Single 'd']
  >>> encodeModified "aaaabccaadeeee" []
  [Multiple 4 'a',Single 'b',Multiple 2 'c',Multiple 2 'a',Single 'd',Multiple 4 'e']
  >>> encodeModified "" []
  [Empty]
  >>> encodeModified "a" []
  [Single 'a']
  >>> encodeModified "ab" []
  [Single 'a',Single 'b']
  >>> encodeModified "abbbbb" []
  [Single 'a',Multiple 5 'b']
 -}

encodeModified' xs = [y | x <- group xs,
                               let y = if length x == 1
                                       then Single (head x)
                                       else Multiple (length x) (head x)]


{-| encodeModifed' Test
  >>> encodeModified' "aaabcccd"
  [Multiple 3 'a',Single 'b',Multiple 3 'c',Single 'd']
  >>> encodeModified' "aaaabccaadeeee"
  [Multiple 4 'a',Single 'b',Multiple 2 'c',Multiple 2 'a',Single 'd',Multiple 4 'e']
  >>> encodeModified' ""
  []
  >>> encodeModified' "a"
  [Single 'a']
  >>> encodeModified' "ab"
  [Single 'a',Single 'b']
  >>> encodeModified' "abbbbb"
  [Single 'a',Multiple 5 'b']
 -}

main :: IO ()
main = do
  str <- getLine
  print $ encodeModified str []