Working on second part?

app/6.hs

@@ -3,17 +3,19 @@ module Main where
 
 import Data.Functor
 import Data.List
-import Data.Matrix
+import Data.Matrix hiding (trace)
+import Debug.Trace
 
 data Dir where
   N,E,W,S :: Dir
-  deriving Eq
+  deriving (Eq, Show)
 
 data Pos where
   Marked   :: Pos
   Unmarked :: Pos
   Guard    :: Dir -> Pos
   Crate    :: Pos
+  Obstacle :: Pos
   deriving Eq
 
 instance Show Pos where
@@ -25,6 +27,7 @@ instance Show Pos where
               Guard W  -> "<"
               Guard S  -> "v"
               Crate    -> "#"
+              Obstacle -> "O"
 
 parse :: String -> Matrix Pos
 parse = fromLists . (((\case
@@ -35,6 +38,7 @@ parse = fromLists . (((\case
               '<' -> Guard W
               'v' -> Guard S
               '#' -> Crate
+              'O' -> Obstacle
              ) <$>) <$>) . lines
 
 guardPos :: Matrix Pos -> (Int, Int, Dir)
@@ -63,7 +67,8 @@ move s (y,x,d) = let (y',x',d') = case d of
                  in
                    case t of
                      Crate -> setElem (Guard d') (y,x) s
-                     _ -> setElem (Guard d) (y',x') $ setElem (Marked) (y,x) s
+                     Obstacle -> setElem (Guard d') (y,x) s
+                     _ -> setElem (Guard d) (y',x') $ setElem Marked (y,x) s
 
 
 traversal :: Matrix Pos -> Matrix Pos
@@ -81,10 +86,41 @@ solve1 = sum . (length . filter (\case
                                   _ -> False
                               ) <$>) . toLists . traversal
 
+isLoop :: Matrix Pos -> [(Int,Int,Dir)] -> Bool
+isLoop s v = let i@(y,x,d) = guardPos s
+                 s' = move s i in
+  if | y == 1       && d == N -> False
+     | y == nrows s && d == S -> False
+     | x == 1       && d == W -> False
+     | x == ncols s && d == E -> False
+     | elem i v -> True
+     | otherwise -> isLoop s' (i:v)
+
+
+traversal' :: Matrix Pos -> [(Int,Int)] -> [(Int,Int)]
+traversal' s v = let i@(y,x,d) = guardPos s
+                     inf = case d of
+                                N -> (y-1,x)
+                                E -> (y,x+1)
+                                W -> (y,x-1)
+                                S -> (y+1,x)
+  in
+  if | y == 1       && d == N -> v
+     | y == nrows s && d == S -> v
+     | x == 1       && d == W -> v
+     | x == ncols s && d == E -> v
+     | otherwise ->
+       let t = (setElem Obstacle inf s) in
+         --trace ("t: " ++ show t) $
+       if isLoop t []
+                        then traversal' (move s i) ((y,x):v)
+                        else traversal' (move s i) v
+
+
 solve2 :: Matrix Pos -> Int
-solve2 = undefined
+solve2 s = length . (`traversal'` []) $ s
 
 main :: IO ()
 main = readFile "inputs/6" <&> parse >>= \i ->
-       print (solve1 i)
+       print (solve1 i) >>
-       -- >> print (solve2 i)
+       print (solve2 i)