@@ -1,12 +1,16 @@
1+{-# LANGUAGE LambdaCase #-}
1{-# LANGUAGE OverloadedStrings #-}
2{-# LANGUAGE OverloadedStrings #-}
3module Obelisk.Command.Preprocessor where
4module Obelisk.Command.Preprocessor where
5import qualified Data.ByteString as BS
6import qualified Data.ByteString as BS
6import qualified Data.ByteString.Lazy as BL
7import qualified Data.ByteString.Lazy as BL
8+import qualified Data.ByteString.Lazy.Builder as BU
7import Data.List
9import Data.List
8import qualified Data.Text.Lazy as TL
11import qualified Data.Text.Lazy as TL
9import qualified Data.Text.Lazy.Builder as TL
12import qualified Data.Text.Lazy.Builder as TL
13+import qualified Data.Text.Lazy.Encoding as TL
10import Distribution.Compiler
14import Distribution.Compiler
11import Language.Haskell.Extension
15import Language.Haskell.Extension
12import System.Environment
16import System.Environment
@@ -14,6 +18,7 @@ import System.IO
14import System.FilePath
18import System.FilePath
16import Obelisk.App
20import Obelisk.App
21+import Obelisk.Command (mkObeliskConfig)
17import Obelisk.Command.Run
22import Obelisk.Command.Run
19main :: IO ()
24main :: IO ()
@@ -26,8 +31,8 @@ main = do
27 args@(origPath:inPath:outPath:packagePaths) <- getArgs
32 args@(origPath:inPath:outPath:packagePaths) <- getArgs
29− outFile <- hOpen outPath WriteMode
34+ outFile <- openFile outPath WriteMode
30− let hPutTextBuilder h = BL.hPutBuilder h . TL.encodeUtf8Builder . TL.toLazyText
35+ let hPutTextBuilder h = BU.hPutBuilder h . TL.encodeUtf8Builder . TL.toLazyText
32 putStr "--------------------------------------------------------------------------------\n"
37 putStr "--------------------------------------------------------------------------------\n"
33 print args
38 print args
@@ -35,18 +40,20 @@ main = do
36 -- Thus we must select among the packagePaths for the file we are going to parse.
41 -- Thus we must select among the packagePaths for the file we are going to parse.
38− let takeDirs = takeWhile hasTrailingPathSeperator
43+ let takeDirs = takeWhile hasTrailingPathSeparator
39 packageDirs = sortOn (negate . length . takeDirs) $ map (splitPath . normalise) packagePaths
44 packageDirs = sortOn (negate . length . takeDirs) $ map (splitPath . normalise) packagePaths
40 origDir = splitPath $ normalise $ origPath
45 origDir = splitPath $ normalise $ origPath
41− matches = [ d | d <- packageDirs, takeDirs d `isPrefixOf` origDir ]
46+ matches = [ joinPath d | d <- packageDirs, takeDirs d `isPrefixOf` origDir ]
43 -- So the first element of matches is going to be the deepest path to a package spec that contains
48 -- So the first element of matches is going to be the deepest path to a package spec that contains
44 -- our file as a subdirectory.
49 -- our file as a subdirectory.
51+ config <- mkObeliskConfig
46 case matches of
53 case matches of
47 [] -> hPutTextBuilder outFile (lineNumberPragma origPath) -- TODO: probably should produce a warning
54 [] -> hPutTextBuilder outFile (lineNumberPragma origPath) -- TODO: probably should produce a warning
48 (packagePath:_) -> do
55 (packagePath:_) -> do
49− runObelisk (ObeliskT mempty) (parseCabalPackage packagePath) >>= \case
56+ runObelisk config (parseCabalPackage packagePath) >>= \case
50 Just packageInfo -> do
57 Just packageInfo -> do
51 hPutTextBuilder outFile (generateHeader origPath packageInfo)
58 hPutTextBuilder outFile (generateHeader origPath packageInfo)
@@ -74,7 +81,7 @@ generateHeader origPath packageInfo =
75 ghcOptions =
82 ghcOptions =
76 if not (null optList)
83 if not (null optList)
77− then TL.fromText "{-# OPTIONS_GHC " <>
84+ then TL.fromText "{-# OPTIONS_GHC "
78 <> mconcat (intersperse (TL.fromText " ") optList)
85 <> mconcat (intersperse (TL.fromText " ") optList)
79 <> TL.fromText " #-}\n"
86 <> TL.fromText " #-}\n"
80 else mempty
87 else mempty