diff --git a/advent-of-code-2023.cabal b/advent-of-code-2023.cabal
index 4568ae4..b81f0da 100644
--- a/advent-of-code-2023.cabal
+++ b/advent-of-code-2023.cabal
@@ -110,8 +110,9 @@ executable day15
     default-language: Haskell2010
 
 executable day16
-    main-is:          Main.hs
-    other-modules:    Commons Part1 Part2
-    build-depends:    base ^>=4.15.1.0, array, containers
-    hs-source-dirs:   day16
-    default-language: Haskell2010
+    main-is:            Main.hs
+    other-modules:      Commons Part1 Part2
+    build-depends:      base ^>=4.15.1.0, array, containers
+    hs-source-dirs:     day16
+    default-language:   Haskell2010
+    default-extensions: LambdaCase
diff --git a/day16/Commons.hs b/day16/Commons.hs
index 3ca5f73..e115a89 100644
--- a/day16/Commons.hs
+++ b/day16/Commons.hs
@@ -11,12 +11,12 @@ type Cavern = Array (Int, Int) Tile
 
 
 parseLine :: String -> [Tile]
-parseLine [] = []
-parseLine ('/': t) = Mirror: parseLine t
-parseLine ('\\': t) = AntiMirror: parseLine t
-parseLine ('-': t) = HSplitter: parseLine t
-parseLine ('|': t) = VSplitter: parseLine t
-parseLine ('.': t) = Empty: parseLine t
+parseLine = map (\case
+                  '/'  -> Mirror
+                  '\\' -> AntiMirror
+                  '-'  -> HSplitter
+                  '|'  -> VSplitter
+                  '.'  -> Empty)
 
 parseCavern :: IO [[Tile]]
 parseCavern = do done <- isEOF
@@ -32,36 +32,52 @@ parse = do cavern <- parseCavern
            return (listArray ((1, 1), (length cavern, length $ head cavern)) $ concat cavern)
 
 
+lightBeamEast :: (Int, Int) -> Direction -> Set (Int, Int, Direction) -> Cavern -> Set (Int, Int, Direction)
+lightBeamEast (y, x) d en = lightBeam (y, x + 1) d $ insert (y, x, East) en
+
+lightBeamSouth :: (Int, Int) -> Direction -> Set (Int, Int, Direction) -> Cavern -> Set (Int, Int, Direction)
+lightBeamSouth (y, x) d en = lightBeam (y + 1, x) d $ insert (y, x, South) en
+
+lightBeamWest :: (Int, Int) -> Direction -> Set (Int, Int, Direction) -> Cavern -> Set (Int, Int, Direction)
+lightBeamWest (y, x) d en = lightBeam (y, x - 1) d $ insert (y, x, West) en
+
+lightBeamNorth :: (Int, Int) -> Direction -> Set (Int, Int, Direction) -> Cavern -> Set (Int, Int, Direction)
+lightBeamNorth (y, x) d en = lightBeam (y - 1, x) d $ insert (y, x, North) en
+
 lightBeam :: (Int, Int) -> Direction -> Set (Int, Int, Direction) -> Cavern -> Set (Int, Int, Direction)
 lightBeam (y, x) East en c
-  | member (y, x, East) en                                 = en
-  | not (inRange (bounds c) (y, x + 1))                    = insert (y, x, East) en
-  | let t = c ! (y, x + 1) in t == Empty || t == HSplitter = lightBeam (y, x + 1) East (insert (y, x, East) en) c
-  | c ! (y, x + 1) == Mirror                               = lightBeam (y, x + 1) North (insert (y, x, East) en) c
-  | c ! (y, x + 1) == AntiMirror                           = lightBeam (y, x + 1) South (insert (y, x, East) en) c
-  | c ! (y, x + 1) == VSplitter                            =
-      let en2 = lightBeam (y, x + 1) North (insert (y, x, East) en) c in lightBeam (y, x + 1) South en2 c
+  | member (y, x, East) en              = en
+  | not $ inRange (bounds c) (y, x + 1) = insert (y, x, East) en
+  | otherwise                           =
+      case c ! (y, x + 1) of
+           Mirror     -> lightBeamEast (y, x) North en c
+           AntiMirror -> lightBeamEast (y, x) South en c
+           VSplitter  -> lightBeamEast (y, x) South (lightBeamEast (y, x) North en c) c
+           _          -> lightBeamEast (y, x) East en c
 lightBeam (y, x) West en c
-  | member (y, x, West) en                                 = en
-  | not (inRange (bounds c) (y, x - 1))                    = insert (y, x, West) en
-  | let t = c ! (y, x - 1) in t == Empty || t == HSplitter = lightBeam (y, x - 1) West (insert (y, x, West) en) c
-  | c ! (y, x - 1) == Mirror                               = lightBeam (y, x - 1) South (insert (y, x, West) en) c
-  | c ! (y, x - 1) == AntiMirror                           = lightBeam (y, x - 1) North (insert (y, x, West) en) c
-  | c ! (y, x - 1) == VSplitter                            =
-      let en2 = lightBeam (y, x - 1) North (insert (y, x, West) en) c in lightBeam (y, x - 1) South en2 c
+  | member (y, x, West) en              = en
+  | not $ inRange (bounds c) (y, x - 1) = insert (y, x, West) en
+  | otherwise                           =
+      case c ! (y, x - 1) of
+           Mirror     -> lightBeamWest (y, x) South en c
+           AntiMirror -> lightBeamWest (y, x) North en c
+           VSplitter  -> lightBeamWest (y, x) South (lightBeamWest (y, x) North en c) c
+           _          -> lightBeamWest (y, x) West en c
 lightBeam (y, x) South en c
-  | member (y, x, South) en                                = en
-  | not (inRange (bounds c) (y + 1, x))                    = insert (y, x, South) en
-  | let t = c ! (y + 1, x) in t == Empty || t == VSplitter = lightBeam (y + 1, x) South (insert (y, x, South) en) c
-  | c ! (y + 1, x) == Mirror                               = lightBeam (y + 1, x) West (insert (y, x, South) en) c
-  | c ! (y + 1, x) == AntiMirror                           = lightBeam (y + 1, x) East (insert (y, x, South) en) c
-  | c ! (y + 1, x) == HSplitter                            =
-      let en2 = lightBeam (y + 1, x) West (insert (y, x, South) en) c in lightBeam (y + 1, x) East en2 c
+  | member (y, x, South) en             = en
+  | not $ inRange (bounds c) (y + 1, x) = insert (y, x, South) en
+  | otherwise                           =
+      case c ! (y + 1, x) of
+           Mirror     -> lightBeamSouth (y, x) West en c
+           AntiMirror -> lightBeamSouth (y, x) East en c
+           HSplitter  -> lightBeamSouth (y, x) East (lightBeamSouth (y, x) West en c) c
+           _          -> lightBeamSouth (y, x) South en c
 lightBeam (y, x) North en c
-  | member (y, x, North) en                                = en
-  | not (inRange (bounds c) (y - 1, x))                    = insert (y, x, North) en
-  | let t = c ! (y - 1, x) in t == Empty || t == VSplitter = lightBeam (y - 1, x) North (insert (y, x, North) en) c
-  | c ! (y - 1, x) == Mirror                               = lightBeam (y - 1, x) East (insert (y, x, North) en) c
-  | c ! (y - 1, x) == AntiMirror                           = lightBeam (y - 1, x) West (insert (y, x, North) en) c
-  | c ! (y - 1, x) == HSplitter                            =
-      let en2 = lightBeam (y - 1, x) West (insert (y, x, North) en) c in lightBeam (y - 1, x) East en2 c
+  | member (y, x, North) en             = en
+  | not $ inRange (bounds c) (y - 1, x) = insert (y, x, North) en
+  | otherwise                           =
+      case c ! (y - 1, x) of
+           Mirror     -> lightBeamNorth (y, x) East en c
+           AntiMirror -> lightBeamNorth (y, x) West en c
+           HSplitter  -> lightBeamNorth (y, x) East (lightBeamNorth (y, x) West en c) c
+           _          -> lightBeamNorth (y, x) North en c
diff --git a/day16/Part2.hs b/day16/Part2.hs
index 14076ec..49dce86 100644
--- a/day16/Part2.hs
+++ b/day16/Part2.hs
@@ -9,10 +9,10 @@ getEnergized :: (Int, Int, Direction) -> Cavern -> [(Int, Int)]
 getEnergized (y0, x0, d) = toList . delete (y0, x0) . Data.Set.map (\ (y, x, _) -> (y, x)) . lightBeam (y0, x0) d empty
 
 getStarts :: Cavern -> [(Int, Int, Direction)]
-getStarts c = [(y, 0, East) | y <- [1..(fst (snd $ bounds c))]]
-              ++ [(y, 1 + snd (snd $ bounds c), West) | y <- [1..(fst (snd $ bounds c))]]
-              ++ [(0, x, South) | x <- [1..(snd (snd $ bounds c))]]
-              ++ [(1 + fst (snd $ bounds c), x, North) | x <- [1..(snd (snd $ bounds c))]]
+getStarts c = [(y, 0, East) | y <- [1..fst (snd $ bounds c)]]
+              ++ [(y, 1 + snd (snd $ bounds c), West) | y <- [1..fst (snd $ bounds c)]]
+              ++ [(0, x, South) | x <- [1..snd (snd $ bounds c)]]
+              ++ [(1 + fst (snd $ bounds c), x, North) | x <- [1..snd (snd $ bounds c)]]
 
 getMaxEnergized :: Cavern -> Int
-getMaxEnergized c = maximum (Prelude.map (\s -> length $ getEnergized s c) $ getStarts c)
+getMaxEnergized c = maximum $ Prelude.map (\s -> length $ getEnergized s c) $ getStarts c