diff --git a/2023/haskell/solutions/Day08.hs b/2023/haskell/solutions/Day08.hs
index 611238b..360c065 100644
--- a/2023/haskell/solutions/Day08.hs
+++ b/2023/haskell/solutions/Day08.hs
@@ -3,6 +3,7 @@ module Day08 (parse, solveA, solveB) where
 
 import Data.Void (Void)
 import Data.Text (Text)
+import Data.List (transpose)
 import Data.Bifunctor (first)
 import Text.Megaparsec (Parsec, errorBundlePretty, runParser, many, eof)
 import Text.Megaparsec.Char (alphaNumChar, space, char)
@@ -42,20 +43,6 @@ parse = first errorBundlePretty . runParser input ""
       eof
       return (path, ns)
 
-
-input :: Text
-input =
-  "RL\n\
-  \\n\
-  \AAA = (BBB, CCC)\n\
-  \BBB = (DDD, EEE)\n\
-  \CCC = (ZZZ, GGG)\n\
-  \DDD = (DDD, DDD)\n\
-  \EEE = (EEE, EEE)\n\
-  \GGG = (GGG, GGG)\n\
-  \ZZZ = (ZZZ, ZZZ)\n"
-
-
 run :: [Node] -> String -> [Dir] -> [(Int, String)]
 run ns start = helper 0 start . cycle
   where
@@ -72,8 +59,9 @@ solveA :: Input -> Int
 solveA (ds, ns) = fst . head . filter (("ZZZ" ==) . snd) $ run ns "AAA" ds
 
 solveB :: Input -> Int
-solveB = const 1
-
--- >>> solveA <$> parse input
--- Right 2
-
+solveB (ds, ns) = frequency . head . transpose . map (filter (('Z' ==) . last . snd)) $ toParallel ns
+  where
+    toParallel :: [Node] -> [[(Int, String)]]
+    toParallel = map (($ ds) . run ns) . filter (('A' ==) . last) . map fst
+    frequency :: [(Int, String)] -> Int
+    frequency = foldl lcm 1 . map fst
diff --git a/2023/haskell/tests/Main.hs b/2023/haskell/tests/Main.hs
index fcb5573..11b2e41 100644
--- a/2023/haskell/tests/Main.hs
+++ b/2023/haskell/tests/Main.hs
@@ -10,6 +10,7 @@ import qualified Day04
 import qualified Day05
 import qualified Day06
 import qualified Day07
+import qualified Day08
 
 
 day01 :: Test
@@ -54,9 +55,9 @@ day03 :: Test
 day03 =
   let parsed = Day03.parse input
   in TestList
-  [ TestCase $ assertEqual "A" (Right 4361)   (Day03.solveA <$> parsed)
-  , TestCase $ assertEqual "B" (Right 467835) (Day03.solveB <$> parsed)
-  ]
+    [ TestCase $ assertEqual "A" (Right 4361)   (Day03.solveA <$> parsed)
+    , TestCase $ assertEqual "B" (Right 467835) (Day03.solveB <$> parsed)
+    ]
   where
     input =
       "467..114..\n\
@@ -133,8 +134,8 @@ day06 :: Test
 day06 =
   let parsed = Day06.parse input
   in TestList
-      [ TestCase $ assertEqual "A" (Right 288)   (Day06.solveA <$> parsed)
-      , TestCase $ assertEqual "B" (Right 71503) (Day06.solveB <$> parsed)
+    [ TestCase $ assertEqual "A" (Right 288)   (Day06.solveA <$> parsed)
+    , TestCase $ assertEqual "B" (Right 71503) (Day06.solveB <$> parsed)
     ]
   where
     input =
@@ -156,6 +157,45 @@ day07 =
       \KTJJT 220\n\
       \QQQJA 483\n"
 
+day08 :: Test
+day08 =
+  let parsedA1 = Day08.parse inputA1
+      parsedA2 = Day08.parse inputA2
+      parsedB  = Day08.parse inputB
+  in TestList
+    [ TestCase $ assertEqual "A" (Right 2) (Day08.solveA <$> parsedA1)
+    , TestCase $ assertEqual "A" (Right 6) (Day08.solveA <$> parsedA2)
+    , TestCase $ assertEqual "B" (Right 6) (Day08.solveB <$> parsedB)
+    ]
+  where
+    inputA1 =
+      "RL\n\
+      \\n\
+      \AAA = (BBB, CCC)\n\
+      \BBB = (DDD, EEE)\n\
+      \CCC = (ZZZ, GGG)\n\
+      \DDD = (DDD, DDD)\n\
+      \EEE = (EEE, EEE)\n\
+      \GGG = (GGG, GGG)\n\
+      \ZZZ = (ZZZ, ZZZ)\n"
+    inputA2 =
+      "LLR\n\
+      \\n\
+      \AAA = (BBB, BBB)\n\
+      \BBB = (AAA, ZZZ)\n\
+      \ZZZ = (ZZZ, ZZZ)\n"
+    inputB =
+      "LR\n\
+      \\n\
+      \11A = (11B, XXX)\n\
+      \11B = (XXX, 11Z)\n\
+      \11Z = (11B, XXX)\n\
+      \22A = (22B, XXX)\n\
+      \22B = (22C, 22C)\n\
+      \22C = (22Z, 22Z)\n\
+      \22Z = (22B, 22B)\n\
+      \XXX = (XXX, XXX)\n"
+
 tests :: Test
 tests = TestList
   [ TestLabel "day01" day01
@@ -165,6 +205,7 @@ tests = TestList
   , TestLabel "day05" day05
   , TestLabel "day06" day06
   , TestLabel "day07" day07
+  , TestLabel "day08" day08
   ]
 
 main :: IO ()