Implementation of 4Clojure problem #112 in Haskell See: http://www.4clojure.com/problem/112

SequsHorribilis.hs

module SequsHorribilis
where

import Test.HUnit

type Sequs = [Horribilis]
data Horribilis = Atom Int | List Sequs
    deriving (Eq, Show)

upThru :: Int -> Sequs -> Sequs
upThru n = snd . go (Just n)
  where
    go cond     []                      = (cond, [])
    go (Just i) (Atom j : s) | j <= i   = Atom j `on` go (Just $ i - j) s
    go _        (Atom j : s)            = (Nothing, [])
    go cond     (List t : s)            = let (cond', t') = go cond t
                                          in List t' `on` go cond' s

    h `on` (c,s) = (c, h:s)


in1 = [Atom 1, Atom 2, List [Atom 3, List [Atom 4, Atom 5], Atom 6], Atom 7]
ex1 = [Atom 1, Atom 2, List [Atom 3, List [Atom 4]]]
test1 = upThru 10 in1 ~?= ex1

in2 = [Atom 1, Atom 2, List [Atom 3, List [Atom 4, List [Atom 5, List [Atom 6, List [Atom 7, Atom 8]], Atom 9]], Atom 10], Atom 11]
ex2 = [Atom 1, Atom 2, List [Atom 3, List [Atom 4, List [Atom 5, List [Atom 6, List [Atom 7]]]]]]
test2 = upThru 30 in2 ~?= ex2

in3 = map Atom [0..]
ex3 = [Atom 0, Atom 1, Atom 2, Atom 3]
test3 = upThru 9 in3 ~?= ex3

in4 = [List [List [List [List [Atom 1]]]]]
ex4 = in4
test4 = upThru 1 in4 ~?= ex4

in5 = in1
ex5 = []
test5 = upThru 0 in5 ~?= ex5

in6 = [Atom 0, Atom 0, List [Atom 0, List [Atom 0]]]
ex6 = in6
test6 = upThru 0 in6 ~?= ex6

in7 = [Atom (-10), List [Atom 1, List [Atom 2, Atom 3, List [Atom 4, Atom 5, List [Atom 6, Atom 7, List [Atom 8]]]]]]
ex7 = [Atom (-10), List [Atom 1, List [Atom 2, Atom 3, List [Atom 4]]]]
test7 = upThru 1 in7 ~?= ex7


allTests = TestList [test1, test2, test3, test4, test5, test6, test7]

main :: IO ()
main = runTestTT allTests >> return ()