Day ten part 1

day-10-haskell/src/Common.hs

@@ -0,0 +1,27 @@
+module Common where
+
+import Control.Monad (join)
+import Text.Read (readMaybe)
+import Flow
+
+type WorldMap = [[Maybe Int]]
+type Position = (Int, Int)
+
+parseMap :: String -> WorldMap
+parseMap input = lines input >>= pure . map readTile
+  where
+    readTile :: Char -> Maybe Int
+    readTile c = readMaybe [c]
+
+findInMap :: Int -> WorldMap -> [Position]
+findInMap _ [] = []
+findInMap needle haystack = enumerate haystack |> map (\(y, line) -> findInLine (0, y) line) |> join
+  where
+    enumerate = zip [0..]
+    findInLine :: Position -> [Maybe Int] -> [Position]
+    findInLine _ [] = []
+    findInLine pos@(x, y) ((Just element):rest)
+      | element == needle = pos : findInLine (x+1, y) rest
+      | otherwise = findInLine (x+1, y) rest
+    findInLine (x, y) (Nothing:rest) = findInLine (x+1, y) rest
+

day-10-haskell/src/Task1.hs

@@ -0,0 +1,33 @@
+module Task1 (task1) where
+
+import Common
+import Data.List ((!?))
+import qualified Data.Set as Set
+import Control.Monad (join)
+import Flow
+
+task1 :: String -> IO Int
+task1 input = let worldMap = parseMap input
+                  trailheads = findInMap 0 worldMap
+              in trailheads >>= followToHills worldMap |> map length |> sum |> return
+  where
+    followToHills :: WorldMap -> Position -> [Position]
+    followToHills worldMap trailhead = followAllUp 0 [trailhead]
+      where
+        followAllUp :: Int -> [Position] -> [Position]
+        followAllUp 9 positions = positions
+        followAllUp height positions = positions |> map followUp |> join |> Set.fromList |> Set.toList |> followAllUp (height + 1)
+          where
+            followUp :: Position -> [Position]
+            followUp pos = [(0, -1), (-1, 0), (0, 1), (1, 0)] |> map (offset pos) |> filter canGoUp
+
+            canGoUp :: Position -> Bool
+            canGoUp (x, y) = case worldMap !? y of
+              Nothing -> False
+              Just line -> case line !? x of
+                Nothing -> False
+                Just Nothing -> False
+                Just (Just element) -> element == height + 1
+
+    offset :: Position -> Position -> Position
+    offset (x1, y1) (x2, y2) = (x1 + x2, y1 + y2)