180.hs

{-
The Look and Say sequence is an interesting sequence of numbers where each term is given by describing the makeup of the previous term.

The 1st term is given as 1. The 2nd term is 11 ('one one') because the first term (1) consisted of a single 1. The 3rd term is then 21 ('two one') because the second term consisted of two 1s. The first 6 terms are:

1
11
21
1211
111221
312211
-}

{-# LANGUAGE LambdaCase #-}

import Data.Foldable (foldlM)
import Control.Monad.Writer.Strict
import qualified Data.DList as DList
import System.Environment (getArgs)

-- data Writer w a = Writer w a


-- instance (Monoid w) => Monad (Writer w) where
--     return x = Writer mempty x
--     (Writer w a) >>= f = let Writer w' b = f a in
--                             Writer (w `mappend` w') b

-- tell x = Writer x ()


runLengthEncode [] = []
runLengthEncode (x:xs) = go 1 x xs
    where go n x [] = [(n, x)]
          go n x (y:ys)
            | y == x = go (n+1) x ys
            | otherwise = (n, x) : go 1 y ys

rleList :: (Eq a) => [a] -> [(Int, a)]
-- The `>>= tell` makes sure the last element is also tallied, since we only
-- tell in f upon finding a different element.
rleList [] = []
rleList (x:xs) = snd . runWriter $ foldlM f (1,x) xs >>= tell . (:[])
    where
        f (n,x) y | y == x    = return (n+1, x)
                  | otherwise = do tell [(n,x)]
                                   return (1,y)

rle :: (Eq a) => [a] -> [(Int, a)]
-- The `>>= tell` makes sure the last element is also tallied, since we only
-- tell in f upon finding a different element.
rle [] = []
rle (x:xs) = DList.toList . snd . runWriter $ foldlM f (1,x) xs >>= tell . DList.singleton
    where
        f (n,x) y | y == x    = return (n+1, x)
                  | otherwise = do tell $ DList.singleton (n,x)
                                   return (1,y)

step xs = concatMap go $ rle xs
    where go (n,c) = (show n ++ [c])

repeated 0 f a = a
repeated n f a = repeated (n-1) f (f a)

main = getArgs >>= \case
        [n] -> go (read n) "1"
        [n, seed] -> go (read n) seed
        _ -> putStrLn "Usage: 180 n [seed]"
    where go n seed = putStrLn $ repeated n step seed