@@ -11,49 +11,48 @@ import qualified Data.Text.Lazy.Builder as TL
1111import qualified Data.Text.Lazy.Encoding as TL
1212import Distribution.Compiler (CompilerFlavor (..))
1313import Language.Haskell.Extension (Extension (..), Language(..))
14−import System.IO (IOMode (..), hClose, hPutStrLn, openFile, stderr)
15−import System.FilePath (hasTrailingPathSeparator, joinPath, normalise, splitPath)
14+import System.Directory (canonicalizePath)
15+import System.IO (IOMode (..), hPutStrLn, stderr, withFile)
16+import System.FilePath (hasTrailingPathSeparator, joinPath, splitPath)
1617
1718import Obelisk.Command.Run (CabalPackageInfo (..), parseCabalPackage')
1819
1920applyPackages :: FilePath -> FilePath -> FilePath -> [FilePath] -> IO ()
20−applyPackages origPath inPath outPath packagePaths = do
21+applyPackages origPath inPath outPath packagePaths' = withFile outPath WriteMode $ \outFile -> do
2122 -- This code is intended to be executed via ghci's -pgmF preprocessor option
2223 -- The command line arguments are passed in via ghc, which dictates the first three options and meanings
23− -- In order for this code to execute, origPath must contain either a '.' character or a '/' character.
24+ -- In order for this code to execute, origPath must contain either a '.' character or a '/' character.
2425 -- (This is to avoid the possibility of the command line syntax conflicting with another ob command)
2526 -- We do have control over the remaining arguments, but they must be the same for all files.
2627 -- Thus, the fourth command line argument must be "apply-packages", which has already been handled.
2728 -- We assume all the remaining arguments passed in are paths to cabal or hpack package specifications.
28−
29− outFile <- openFile outPath WriteMode
30− let hPutTextBuilder h = BU.hPutBuilder h . TL.encodeUtf8Builder . TL.toLazyText
31−
32− -- putStr "--------------------------------------------------------------------------------\n"
33− -- print args
34− -- putStr "--------------------------------------------------------------------------------\n"
35−
3629 -- Thus we must select among the packagePaths for the file we are going to parse.
3730
31+ origPathCanonical <- canonicalizePath origPath
32+ packagePaths <- traverse canonicalizePath packagePaths'
33+
3834 let takeDirs = takeWhile hasTrailingPathSeparator
39− packageDirs = sortOn (negate . length . takeDirs) $ map (splitPath . normalise) packagePaths
40− origDir = splitPath $ normalise origPath
35+ packageDirs = sortOn (negate . length . takeDirs) $ map splitPath packagePaths
36+ origDir = splitPath origPathCanonical
4137 matches = [ joinPath d | d <- packageDirs, takeDirs d `isPrefixOf` origDir ]
4238
4339 -- So the first element of matches is going to be the deepest path to a package spec that contains
4440 -- our file as a subdirectory.
4541
4642 case matches of
47− [] -> hPutTextBuilder outFile (lineNumberPragma origPath) -- TODO: probably should produce a warning
48− (packagePath:_) -> do
43+ [] ->
44+ hPutStrLn stderr $ "Error: Unable to find cabal information for " <> origPath <> "; Skipping preprocessor."
45+ packagePath:_ -> do
4946 parseCabalPackage' packagePath >>= \case
5047 Left err ->
51− hPutStrLn stderr $ "Error: Unable to parse cabal package " <> packagePath <> "; Skipping preprocessor on " <> origPath <> ". Error was " <> show err
48+ hPutStrLn stderr $ "Error: Unable to parse cabal package " <> packagePath <> "; Skipping preprocessor on " <> origPath <> ". Error: " <> show err
5249 Right (_warnings, packageInfo) ->
5350 hPutTextBuilder outFile (generateHeader origPath packageInfo)
5451
5552 BL.readFile inPath >>= BL.hPut outFile
56− hClose outFile
53+
54+ where
55+ hPutTextBuilder h = BU.hPutBuilder h . TL.encodeUtf8Builder . TL.toLazyText
5756
5857
5958 -- I'm pretty sure there's a certain amount of oversimplification in CabalPackageInfo, so I doubt this is fully robust.
@@ -87,7 +86,7 @@ generateHeader origPath packageInfo =
8786 <> TL.fromText " #-}\n"
8887 else mempty
8988 optList = map TL.fromString
90− $ filter (\x -> not (isPrefixOf "-O" x))
89+ $ filter (not . isPrefixOf "-O")
9190 $ fromMaybe []
9291 $ lookup GHC (_cabalPackageInfo_compilerOptions packageInfo)
9392