praxis

commit 82d5dd058a01747770d46c8f38b083ef6d8f8695
parent 709bb1f9376992367d4b3527155d98d12e02bf58
Author: Jared Tobin <jared@jtobin.ca>
Date:   Mon, 25 Jun 2018 20:08:02 +1200

Uncoupling exercise.

Diffstat:
A
20180615_uncouple/Uncouple.hs
 | 
41
+++++++++++++++++++++++++++++++++++++++++

1 file changed, 41 insertions(+), 0 deletions(-)
diff --git a/20180615_uncouple/Uncouple.hs b/20180615_uncouple/Uncouple.hs
@@ -0,0 +1,41 @@
+{-# OPTIONS_GHC -Wall #-}
+{-# LANGUAGE LambdaCase #-}
+
+import Data.Function (fix)
+
+coupled :: Eq a => [a] -> Bool
+coupled xs =
+  let loop rec acc recent = \case
+        []     -> acc
+        (h:t) -> (Just h == recent) || rec False (Just h) t
+
+  in  fix loop False Nothing xs
+
+decouple :: Eq a => [a] -> [a]
+decouple xs =
+  let loop rec acc recent = \case
+        []    -> acc
+        (h:t) ->
+          if   Just h == recent
+          then rec (drop 1 acc) Nothing t
+          else rec (h : acc) (Just h) t
+
+  in  reverse (fix loop [] Nothing xs)
+
+uncouple :: Eq a => [a] -> [a]
+uncouple xs =
+  let loop rec input
+        | coupled input = rec (decouple input)
+        | otherwise     = input
+
+  in  fix loop xs
+
+data Colour =
+    Red
+  | Blue
+  | Green
+  deriving (Eq, Show)
+
+main :: IO ()
+main = print (uncouple [Red, Red, Blue, Green, Green, Blue, Green])
+