September Morn Update

Task/ABC-Problem/Haskell/abc-problem-2.hs

@@ -1,16 +1,13 @@
 import Data.List (delete)
 import Data.Char (toUpper)
 
--- Any block sequences found
 spellWith :: [String] -> String -> [[String]]
 spellWith _ [] = [[]]
 spellWith blocks (x:xs) =
-  foldMap
-    (\b ->
-        if x `elem` b
-          then foldMap (return . (b :)) (spellWith (delete b blocks) xs)
-          else [])
-    blocks
+  let go b
+        | x `elem` b = (b :) <$> spellWith (delete b blocks) xs
+        | otherwise = []
+  in blocks >>= go
 
 blocks :: [String]
 blocks = words "BO XK DQ CP NA GT RE TG QD FS JW HU VI AN OB ER FS LY PC ZM"
@@ -18,5 +15,5 @@ blocks = words "BO XK DQ CP NA GT RE TG QD FS JW HU VI AN OB ER FS LY PC ZM"
 main :: IO ()
 main =
   mapM_
-    (print . ((,) <*>) (not . null . spellWith blocks . (toUpper <$>)))
+    (print . ((,) <*>) (not . null . spellWith blocks . fmap toUpper))
     ["", "A", "BARK", "BoOK", "TrEAT", "COmMoN", "SQUAD", "conFUsE"]