Uncouple.hs (861B)
1 {-# OPTIONS_GHC -Wall #-} 2 {-# LANGUAGE LambdaCase #-} 3 4 import Data.Function (fix) 5 6 coupled :: Eq a => [a] -> Bool 7 coupled xs = 8 let loop rec acc recent = \case 9 [] -> acc 10 (h:t) -> (Just h == recent) || rec False (Just h) t 11 12 in fix loop False Nothing xs 13 14 decouple :: Eq a => [a] -> [a] 15 decouple xs = 16 let loop rec acc recent = \case 17 [] -> acc 18 (h:t) -> 19 if Just h == recent 20 then rec (drop 1 acc) Nothing t 21 else rec (h : acc) (Just h) t 22 23 in reverse (fix loop [] Nothing xs) 24 25 uncouple :: Eq a => [a] -> [a] 26 uncouple xs = 27 let loop rec input 28 | coupled input = rec (decouple input) 29 | otherwise = input 30 31 in fix loop xs 32 33 data Colour = 34 Red 35 | Blue 36 | Green 37 deriving (Eq, Show) 38 39 main :: IO () 40 main = print (uncouple [Red, Red, Blue, Green, Green, Blue, Green]) 41