From 1cd5b6acc112c12eba30ae822648e889b2268070 Mon Sep 17 00:00:00 2001
From: Tom McLaughlin <tom@codedown.io>
Date: Thu, 25 Jul 2024 19:33:24 -0700
Subject: [PATCH] ci: fix more warnings

---
 .../src/Test/Sandwich/WebDriver/Internal/StartWebDriver.hs    | 2 +-
 .../src/Test/Sandwich/WebDriver/Internal/Video.hs             | 1 +
 .../windows-src/Test/Sandwich/WebDriver/Resolution.hsc        | 2 +-
 sandwich/src/Test/Sandwich/Interpreters/StartTree.hs          | 2 +-
 sandwich/src/Test/Sandwich/TH/ModuleMap.hs                    | 4 +++-
 5 files changed, 7 insertions(+), 4 deletions(-)

diff --git a/sandwich-webdriver/src/Test/Sandwich/WebDriver/Internal/StartWebDriver.hs b/sandwich-webdriver/src/Test/Sandwich/WebDriver/Internal/StartWebDriver.hs
index 00220d67..3c13ff85 100644
--- a/sandwich-webdriver/src/Test/Sandwich/WebDriver/Internal/StartWebDriver.hs
+++ b/sandwich-webdriver/src/Test/Sandwich/WebDriver/Internal/StartWebDriver.hs
@@ -16,7 +16,7 @@ import Control.Monad.Logger
 import Control.Monad.Reader
 import Control.Retry
 import Data.Default
-import Data.Function
+import Data.Function (fix)
 import Data.String.Interpolate
 import qualified Data.Text as T
 import GHC.Stack
diff --git a/sandwich-webdriver/src/Test/Sandwich/WebDriver/Internal/Video.hs b/sandwich-webdriver/src/Test/Sandwich/WebDriver/Internal/Video.hs
index ed534239..7ed4bfe3 100644
--- a/sandwich-webdriver/src/Test/Sandwich/WebDriver/Internal/Video.hs
+++ b/sandwich-webdriver/src/Test/Sandwich/WebDriver/Internal/Video.hs
@@ -1,3 +1,4 @@
+{-# OPTIONS_GHC -fno-warn-unused-matches #-}
 {-# LANGUAGE CPP #-}
 
 module Test.Sandwich.WebDriver.Internal.Video where
diff --git a/sandwich-webdriver/windows-src/Test/Sandwich/WebDriver/Resolution.hsc b/sandwich-webdriver/windows-src/Test/Sandwich/WebDriver/Resolution.hsc
index 8d6ed4ce..5db01c02 100644
--- a/sandwich-webdriver/windows-src/Test/Sandwich/WebDriver/Resolution.hsc
+++ b/sandwich-webdriver/windows-src/Test/Sandwich/WebDriver/Resolution.hsc
@@ -13,4 +13,4 @@ getResolution :: IO (Int, Int, Int, Int)
 getResolution = undefined
 
 getResolutionForDisplay :: Int -> IO (Int, Int, Int, Int)
-getResolutionForDisplay n = undefined
+getResolutionForDisplay _n = undefined
diff --git a/sandwich/src/Test/Sandwich/Interpreters/StartTree.hs b/sandwich/src/Test/Sandwich/Interpreters/StartTree.hs
index 3a755573..951fce42 100644
--- a/sandwich/src/Test/Sandwich/Interpreters/StartTree.hs
+++ b/sandwich/src/Test/Sandwich/Interpreters/StartTree.hs
@@ -223,7 +223,6 @@ runInAsync node ctx action = do
                   -- Get a relative path from the error dir to the results dir. System.FilePath doesn't want to
                   -- introduce ".." components, so we have to do it ourselves
                   let errorDirDepth = L.length $ splitPath $ makeRelative runRoot errorsDir
-                  let relativePath = joinPath (L.replicate errorDirDepth "..") </> (makeRelative runRoot dir)
 
                   let symlinkBaseName = case runTreeLoc of
                         Nothing -> takeFileName dir
@@ -239,6 +238,7 @@ runInAsync node ctx action = do
                   -- Don't do createDirectoryLink on Windows, as creating symlinks is generally not allowed for users.
                   -- See https://security.stackexchange.com/questions/10194/why-do-you-have-to-be-an-admin-to-create-a-symlink-in-windows
                   -- TODO: could we detect if this permission is available?
+                  let relativePath = joinPath (L.replicate errorDirDepth "..") </> (makeRelative runRoot dir)
                   liftIO $ createDirectoryLink relativePath symlinkPath
 #endif
 
diff --git a/sandwich/src/Test/Sandwich/TH/ModuleMap.hs b/sandwich/src/Test/Sandwich/TH/ModuleMap.hs
index 7d2d8f17..d32e7489 100644
--- a/sandwich/src/Test/Sandwich/TH/ModuleMap.hs
+++ b/sandwich/src/Test/Sandwich/TH/ModuleMap.hs
@@ -24,7 +24,9 @@ addModuleToMap relativeTo modulePrefix mm path@(takeExtension -> ".hs") = case p
     relativePath = (takeFileName relativeTo) </> (makeRelative relativeTo path)
     pathParts = splitDirectories $ dropExtension relativePath
     baseModuleName = last pathParts
-    moduleName = head $ filter doesNotExist (baseModuleName : [baseModuleName <> show n | n <- [(1 :: Integer)..]])
+    moduleName = case filter doesNotExist (baseModuleName : [baseModuleName <> show n | n <- [(1 :: Integer)..]]) of
+      (x:_) -> x
+      _ -> error "Impossible"
     doesNotExist x = isNothing (M.lookup x mm)
 addModuleToMap _ _ mm _ = mm