September 2017 Update

Task/Order-disjoint-list-items/Haskell/order-disjoint-list-items-1.hs

@@ -1,16 +1,33 @@
-import Data.List
+import Data.List (mapAccumL, sort)
 
-order::Ord a => [[a]] -> [a]
-order [ms,ns] = snd.mapAccumL yu ls $ ks
+order
+  :: Ord a
+  => [[a]] -> [a]
+order [ms, ns] = snd . mapAccumL yu ls $ ks
   where
-  ks = zip ms [(0::Int)..]
-  ls = zip ns.sort.snd.foldl go (sort ns,[]).sort $ ks
-  yu ((u,v):us) (_,y) | v == y  = (us,u)
-  yu ys (x,_)                   = (ys,x)
-  go ((u:us),ys) (x,y) | u == x = (us,y:ys)
-  go ts _                       = ts
+    ks = zip ms [(0 :: Int) ..]
+    ls = zip ns . sort . snd . foldl go (sort ns, []) . sort $ ks
+    yu ((u, v):us) (_, y)
+      | v == y = (us, u)
+    yu ys (x, _) = (ys, x)
+    go (u:us, ys) (x, y)
+      | u == x = (us, y : ys)
+    go ts _ = ts
 
-task ls@[ms,ns] = do
-  putStrLn $ "M: " ++ ms ++ " | N: " ++ ns ++ " |> " ++ (unwords.order.map words $ ls)
+task :: [String] -> IO ()
+task ls@[ms, ns] =
+  putStrLn $
+  "M: " ++ ms ++ " | N: " ++ ns ++ " |> " ++ (unwords . order . map words $ ls)
 
-main = mapM_ task [["the cat sat on the mat","mat cat"],["the cat sat on the mat","cat mat"],["A B C A B C A B C","C A C A"],["A B C A B D A B E","E A D A"],["A B","B"],["A B","B A"],["A B B A","B A"]]
+main :: IO ()
+main =
+  mapM_
+    task
+    [ ["the cat sat on the mat", "mat cat"]
+    , ["the cat sat on the mat", "cat mat"]
+    , ["A B C A B C A B C", "C A C A"]
+    , ["A B C A B D A B E", "E A D A"]
+    , ["A B", "B"]
+    , ["A B", "B A"]
+    , ["A B B A", "B A"]
+    ]

Task/Order-disjoint-list-items/Haskell/order-disjoint-list-items-2.hs

@@ -1,44 +1,55 @@
+import Control.Arrow ((***))
 import Prelude hiding (unlines, unwords, words, length)
 import Data.List (delete, transpose)
-import Data.Text hiding (concat, zipWith, foldl, transpose, maximum)
+import Data.Text
+       hiding (concat, zipWith, foldl, transpose, maximum)
 
-
-disjointOrder :: Eq a => [a] -> [a] -> [a]
+disjointOrder
+  :: Eq a
+  => [a] -> [a] -> [a]
 disjointOrder m n = concat $ zipWith (++) ms ns
-    where
-      ms = segments m n
-      ns = ((:[]) <$> n) ++ [[]] -- as list of lists, lengthened by 1
-
-      segments :: Eq a => [a] -> [a] -> [[a]]
-      segments m n = _m ++ [_acc]
-        where
-          (_m, _, _acc) = foldl split ([], n, []) m
-
-          split :: Eq a => ([[a]],[a],[a]) -> a -> ([[a]],[a],[a])
-          split (ms, ns, acc) x
-            | elem x ns = (ms ++ [acc], delete x ns, [])
-            | otherwise = (ms, ns, acc ++ [x])
-
+  where
+    ms = segments m n
+    ns = ((: []) <$> n) ++ [[]] -- as list of lists, lengthened by 1
+    segments
+      :: Eq a
+      => [a] -> [a] -> [[a]]
+    segments m n = _m ++ [_acc]
+      where
+        (_m, _, _acc) = foldl split ([], n, []) m
+        split
+          :: Eq a
+          => ([[a]], [a], [a]) -> a -> ([[a]], [a], [a])
+        split (ms, ns, acc) x
+          | x `elem` ns = (ms ++ [acc], delete x ns, [])
+          | otherwise = (ms, ns, acc ++ [x])
 
 -- TEST -----------------------------------------------------------
-
 tests :: [(Text, Text)]
-tests = (\(a, b) -> (pack a, pack b)) <$>
-         [("the cat sat on the mat","mat cat"),
-          ("the cat sat on the mat","cat mat"),
-          ("A B C A B C A B C","C A C A"),
-          ("A B C A B D A B E","E A D A"),
-          ("A B","B"),
-          ("A B","B A"),
-          ("A B B A","B A")]
+tests =
+  (pack *** pack) <$>
+  [ ("the cat sat on the mat", "mat cat")
+  , ("the cat sat on the mat", "cat mat")
+  , ("A B C A B C A B C", "C A C A")
+  , ("A B C A B D A B E", "E A D A")
+  , ("A B", "B")
+  , ("A B", "B A")
+  , ("A B B A", "B A")
+  ]
 
 table :: Text -> [[Text]] -> Text
-table delim rows = unlines $ (\r -> (intercalate delim r))
-      <$> (transpose $ (\col ->
-        let width = (length $ maximum col)
-        in (justifyLeft width ' ') <$> col) <$> transpose rows)
+table delim rows =
+  unlines $
+  intercalate delim <$>
+  transpose
+    ((\col ->
+         let width = (length $ maximum col)
+         in justifyLeft width ' ' <$> col) <$>
+     transpose rows)
 
 main :: IO ()
-main = putStr $ unpack $ table (pack "  ->  ") $
-  (\(m, n) -> [m, n, unwords (disjointOrder (words m) (words n))])
-  <$> tests
+main =
+  putStr $
+  unpack $
+  table (pack "  ->  ") $
+  (\(m, n) -> [m, n, unwords (disjointOrder (words m) (words n))]) <$> tests