@@ -26,26 +26,29 @@ main = do
27 args@(origPath:inPath:outPath:packagePaths) <- getArgs
27 args@(origPath:inPath:outPath:packagePaths) <- getArgs
29+ outFile <- hOpen outPath WriteMode
30+ let hPutTextBuilder h = BL.hPutBuilder h . TL.encodeUtf8Builder . TL.toLazyText
29 putStr "--------------------------------------------------------------------------------\n"
32 putStr "--------------------------------------------------------------------------------\n"
30 print args
33 print args
31 putStr "--------------------------------------------------------------------------------\n"
34 putStr "--------------------------------------------------------------------------------\n"
33 -- Thus we must select among the packagePaths for the file we are going to parse.
36 -- Thus we must select among the packagePaths for the file we are going to parse.
38+ let takeDirs = takeWhile hasTrailingPathSeperator
35− let packageDirs = sortOn (negate . length) $ map (splitPath . normalise) packagePaths
39+ packageDirs = sortOn (negate . length . takeDirs) $ map (splitPath . normalise) packagePaths
36 origDir = splitPath $ normalise $ origPath
40 origDir = splitPath $ normalise $ origPath
37− matches = [ d | d@(_:_) <- packageDirs, takeWhile hasTrailingPathSeperator d `isPrefixOf` origDir ]
41+ matches = [ d | d <- packageDirs, takeDirs d `isPrefixOf` origDir ]
39 -- So the first element of matches is going to be the deepest path to a package spec that contains
43 -- So the first element of matches is going to be the deepest path to a package spec that contains
40 -- our file as a subdirectory.
44 -- our file as a subdirectory.
42− let hPutTextBuilder outFile = BL.hPutBuilder outFile . TL.encodeUtf8Builder . TL.toLazyText
43 case matches of
46 case matches of
44− [] -> hPutTextBuilder (lineNumberPragma origPath) -- TODO: probably should produce a warning
47+ [] -> hPutTextBuilder outFile (lineNumberPragma origPath) -- TODO: probably should produce a warning
45 (packagePath:_) -> do
48 (packagePath:_) -> do
46 runObelisk (ObeliskT mempty) (parseCabalPackage packagePath) >>= \case
49 runObelisk (ObeliskT mempty) (parseCabalPackage packagePath) >>= \case
47 Just packageInfo -> do
50 Just packageInfo -> do
48− hPutTextBuilder (generateHeader origPath packageInfo)
51+ hPutTextBuilder outFile (generateHeader origPath packageInfo)
50 BL.readFile inPath >>= BL.hPut outFile
53 BL.readFile inPath >>= BL.hPut outFile
51 hClose outFile
54 hClose outFile