ci: fix more warnings

codedownio · Jul 26, 2024 · 1cd5b6a · 1cd5b6a
1 parent 491ba50
commit 1cd5b6a
Show file tree

Hide file tree

Showing 5 changed files with 7 additions and 4 deletions.
diff --git 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
@@ -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
@@ -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
@@ -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
@@ -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