{-# LANGUAGE CPP #-}
module Distribution.Simple.UUAGC.UUAGC(uuagcUserHook,
uuagcUserHook',
uuagc,
uuagcLibUserHook,
uuagcFromString
) where
import Debug.Trace
import Distribution.Simple
import Distribution.Simple.PreProcess
import Distribution.Simple.LocalBuildInfo
import Distribution.Simple.Utils
import Distribution.Simple.Setup
import Distribution.PackageDescription hiding (Flag)
import Distribution.Simple.UUAGC.AbsSyn( AGFileOption(..)
, AGFileOptions
, AGOptionsClass(..)
, lookupFileOptions
, fileClasses
)
import Distribution.Simple.UUAGC.Parser
import Options hiding (verbose)
import Distribution.Verbosity
import System.Process( readProcessWithExitCode )
import System.Directory(getModificationTime
,doesFileExist
,removeFile)
import System.FilePath(pathSeparators,
(</>),
takeFileName,
normalise,
joinPath,
dropFileName,
addExtension,
dropExtension,
replaceExtension,
splitDirectories)
import System.Exit (ExitCode(..))
import System.IO( openFile, IOMode(..),
hFileSize,
hSetFileSize,
hClose,
hGetContents,
hFlush,
Handle(..), stderr, hPutStr, hPutStrLn)
import System.Exit(exitFailure)
import Control.Exception (throwIO)
import Control.Monad (liftM, when, guard, forM_, forM)
import Control.Arrow ((&&&), second)
import Data.Maybe (maybeToList)
import Data.Either (partitionEithers)
import Data.List (nub,intersperse)
import Data.Map (Map)
import qualified Data.Map as Map
#if MIN_VERSION_Cabal(3,6,0)
import Distribution.Utils.Path (getSymbolicPath, PackageDir, SourceDir, SymbolicPath)
#endif
{-# DEPRECATED uuagcUserHook, uuagcUserHook', uuagc "Use uuagcLibUserHook instead" #-}
uuagcn :: String
uuagcn = String
"uuagc"
defUUAGCOptions :: String
defUUAGCOptions :: String
defUUAGCOptions = String
"uuagc_options"
agClassesFile :: String
agClassesFile :: String
agClassesFile = String
"ag_file_options"
agModule :: String
agModule :: String
agModule = String
"x-agmodule"
agClass :: String
agClass :: String
agClass = String
"x-agclass"
uuagcUserHook :: UserHooks
uuagcUserHook :: UserHooks
uuagcUserHook = String -> UserHooks
uuagcUserHook' String
uuagcn
uuagcUserHook' :: String -> UserHooks
uuagcUserHook' :: String -> UserHooks
uuagcUserHook' String
uuagcPath = ([String] -> String -> IO (ExitCode, [String])) -> UserHooks
uuagcLibUserHook (String -> [String] -> String -> IO (ExitCode, [String])
uuagcFromString String
uuagcPath)
uuagcFromString :: String -> [String] -> FilePath -> IO (ExitCode, [FilePath])
uuagcFromString :: String -> [String] -> String -> IO (ExitCode, [String])
uuagcFromString String
uuagcPath [String]
args String
file = do
(ExitCode
ec,String
out,String
err) <- String -> [String] -> String -> IO (ExitCode, String, String)
readProcessWithExitCode String
uuagcPath ([String]
args forall a. [a] -> [a] -> [a]
++ [String
file]) String
""
case ExitCode
ec of
ExitCode
ExitSuccess ->
do Handle -> String -> IO ()
hPutStr Handle
stderr String
err
forall (m :: * -> *) a. Monad m => a -> m a
return (ExitCode
ExitSuccess, String -> [String]
words String
out)
(ExitFailure Int
exc) ->
do Handle -> String -> IO ()
hPutStrLn Handle
stderr (String
uuagcPath forall a. [a] -> [a] -> [a]
++ String
": " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Int
exc)
Handle -> String -> IO ()
hPutStr Handle
stderr String
out
Handle -> String -> IO ()
hPutStr Handle
stderr String
err
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> ExitCode
ExitFailure Int
exc, [])
uuagcLibUserHook :: ([String] -> FilePath -> IO (ExitCode, [FilePath])) -> UserHooks
uuagcLibUserHook :: ([String] -> String -> IO (ExitCode, [String])) -> UserHooks
uuagcLibUserHook [String] -> String -> IO (ExitCode, [String])
uuagc = UserHooks
hooks where
hooks :: UserHooks
hooks = UserHooks
simpleUserHooks { hookedPreProcessors :: [PPSuffixHandler]
hookedPreProcessors = (String
"ag", BuildInfo
-> LocalBuildInfo -> ComponentLocalBuildInfo -> PreProcessor
ag)forall a. a -> [a] -> [a]
:(String
"lag",BuildInfo
-> LocalBuildInfo -> ComponentLocalBuildInfo -> PreProcessor
ag)forall a. a -> [a] -> [a]
:[PPSuffixHandler]
knownSuffixHandlers
, buildHook :: PackageDescription
-> LocalBuildInfo -> UserHooks -> BuildFlags -> IO ()
buildHook = ([String] -> String -> IO (ExitCode, [String]))
-> PackageDescription
-> LocalBuildInfo
-> UserHooks
-> BuildFlags
-> IO ()
uuagcBuildHook [String] -> String -> IO (ExitCode, [String])
uuagc
}
ag :: BuildInfo
-> LocalBuildInfo -> ComponentLocalBuildInfo -> PreProcessor
ag = ([String] -> String -> IO (ExitCode, [String]))
-> BuildInfo
-> LocalBuildInfo
-> ComponentLocalBuildInfo
-> PreProcessor
uuagc' [String] -> String -> IO (ExitCode, [String])
uuagc
originalPreBuild :: [String] -> BuildFlags -> IO HookedBuildInfo
originalPreBuild = UserHooks -> [String] -> BuildFlags -> IO HookedBuildInfo
preBuild UserHooks
simpleUserHooks
originalBuildHook :: PackageDescription
-> LocalBuildInfo -> UserHooks -> BuildFlags -> IO ()
originalBuildHook = UserHooks
-> PackageDescription
-> LocalBuildInfo
-> UserHooks
-> BuildFlags
-> IO ()
buildHook UserHooks
simpleUserHooks
putErrorInfo :: Handle -> IO ()
putErrorInfo :: Handle -> IO ()
putErrorInfo Handle
h = Handle -> IO String
hGetContents Handle
h forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Handle -> String -> IO ()
hPutStr Handle
stderr
updateAGFile :: ([String] -> FilePath -> IO (ExitCode, [FilePath]))
-> Map FilePath (Options, Maybe (FilePath, [String]))
-> (FilePath, (Options, Maybe (FilePath, [String])))
-> IO ()
updateAGFile :: ([String] -> String -> IO (ExitCode, [String]))
-> Map String (Options, Maybe (String, [String]))
-> (String, (Options, Maybe (String, [String])))
-> IO ()
updateAGFile [String] -> String -> IO (ExitCode, [String])
_ Map String (Options, Maybe (String, [String]))
_ (String
_,(Options
_,Maybe (String, [String])
Nothing)) = forall (m :: * -> *) a. Monad m => a -> m a
return ()
updateAGFile [String] -> String -> IO (ExitCode, [String])
uuagc Map String (Options, Maybe (String, [String]))
newOptions (String
file,(Options
opts,Just (String
gen,[String]
sp))) = do
Bool
hasGen <- String -> IO Bool
doesFileExist String
gen
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
hasGen forall a b. (a -> b) -> a -> b
$ do
(ExitCode
ec, [String]
files) <- [String] -> String -> IO (ExitCode, [String])
uuagc (Options -> [String]
optionsToString forall a b. (a -> b) -> a -> b
$ Options
opts { genFileDeps :: Bool
genFileDeps = Bool
True, searchPath :: [String]
searchPath = [String]
sp }) String
file
case ExitCode
ec of
ExitCode
ExitSuccess -> do
let newOpts :: Options
newOpts :: Options
newOpts = forall b a. b -> (a -> b) -> Maybe a -> b
maybe Options
noOptions forall a b. (a, b) -> a
fst forall a b. (a -> b) -> a -> b
$ forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup String
file Map String (Options, Maybe (String, [String]))
newOptions
optRebuild :: Bool
optRebuild = Options -> [String]
optionsToString Options
newOpts forall a. Eq a => a -> a -> Bool
/= Options -> [String]
optionsToString Options
opts
Bool
modRebuild <-
if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
files
then forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
else do
[UTCTime]
flsmt <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM String -> IO UTCTime
getModificationTime [String]
files
let maxModified :: UTCTime
maxModified = forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum [UTCTime]
flsmt
UTCTime
fmt <- String -> IO UTCTime
getModificationTime String
gen
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ UTCTime
maxModified forall a. Ord a => a -> a -> Bool
> UTCTime
fmt
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool
optRebuild Bool -> Bool -> Bool
|| Bool
modRebuild) forall a b. (a -> b) -> a -> b
$ String -> IO ()
removeFile String
gen
ex :: ExitCode
ex@(ExitFailure Int
_) -> forall e a. Exception e => e -> IO a
throwIO ExitCode
ex
getAGFileOptions :: [(String, String)] -> IO AGFileOptions
getAGFileOptions :: [(String, String)] -> IO AGFileOptions
getAGFileOptions [(String, String)]
extra = do
AGFileOptions
cabalOpts <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (String -> IO AGFileOption
parseOptionAG forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd) forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> [a] -> [a]
filter ((forall a. Eq a => a -> a -> Bool
== String
agModule) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst) [(String, String)]
extra
Bool
usesOptionsFile <- String -> IO Bool
doesFileExist String
defUUAGCOptions
if Bool
usesOptionsFile
then do Either ParserError AGFileOptions
r <- String -> IO (Either ParserError AGFileOptions)
parserAG' String
defUUAGCOptions
case Either ParserError AGFileOptions
r of
Left ParserError
e -> forall a. String -> IO a
dieNoVerbosity (forall a. Show a => a -> String
show ParserError
e)
Right AGFileOptions
a -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ AGFileOptions
cabalOpts forall a. [a] -> [a] -> [a]
++ AGFileOptions
a
else forall (m :: * -> *) a. Monad m => a -> m a
return AGFileOptions
cabalOpts
getAGClasses :: [(String, String)] -> IO [AGOptionsClass]
getAGClasses :: [(String, String)] -> IO [AGOptionsClass]
getAGClasses = forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (String -> IO AGOptionsClass
parseClassAG forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
filter ((forall a. Eq a => a -> a -> Bool
== String
agClass) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst)
writeFileOptions :: FilePath -> Map FilePath (Options, Maybe (FilePath,[String])) -> IO ()
writeFileOptions :: String -> Map String (Options, Maybe (String, [String])) -> IO ()
writeFileOptions String
classesPath Map String (Options, Maybe (String, [String]))
opts = do
Handle
hClasses <- String -> IOMode -> IO Handle
openFile String
classesPath IOMode
WriteMode
Handle -> String -> IO ()
hPutStr Handle
hClasses forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show forall a b. (a -> b) -> a -> b
$ forall a b k. (a -> b) -> Map k a -> Map k b
Map.map (\(Options
opt,Maybe (String, [String])
gen) -> (Options -> [String]
optionsToString Options
opt, Maybe (String, [String])
gen)) Map String (Options, Maybe (String, [String]))
opts
Handle -> IO ()
hFlush Handle
hClasses
Handle -> IO ()
hClose Handle
hClasses
readFileOptions :: FilePath -> IO (Map FilePath (Options, Maybe (FilePath,[String])))
readFileOptions :: String -> IO (Map String (Options, Maybe (String, [String])))
readFileOptions String
classesPath = do
Bool
isFile <- String -> IO Bool
doesFileExist String
classesPath
if Bool
isFile
then do Handle
hClasses <- String -> IOMode -> IO Handle
openFile String
classesPath IOMode
ReadMode
String
sClasses <- Handle -> IO String
hGetContents Handle
hClasses
Map String ([String], Maybe (String, [String]))
classes <- forall a. Read a => String -> IO a
readIO String
sClasses :: IO (Map FilePath ([String], Maybe (FilePath,[String])))
Handle -> IO ()
hClose Handle
hClasses
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b k. (a -> b) -> Map k a -> Map k b
Map.map (\([String]
opt,Maybe (String, [String])
gen) -> let (Options
opt',[String]
_,[String]
_) = [String] -> (Options, [String], [String])
getOptions [String]
opt in (Options
opt', Maybe (String, [String])
gen)) Map String ([String], Maybe (String, [String]))
classes
else forall (m :: * -> *) a. Monad m => a -> m a
return forall k a. Map k a
Map.empty
getOptionsFromClass :: [(String, Options)] -> AGFileOption -> ([String], Options)
getOptionsFromClass :: [(String, Options)] -> AGFileOption -> ([String], Options)
getOptionsFromClass [(String, Options)]
classes AGFileOption
fOpt =
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second (forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl Options -> Options -> Options
combineOptions (AGFileOption -> Options
opts AGFileOption
fOpt))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. [Either a b] -> ([a], [b])
partitionEithers forall a b. (a -> b) -> a -> b
$ do
String
fClass <- AGFileOption -> [String]
fileClasses AGFileOption
fOpt
case String
fClass forall a b. Eq a => a -> [(a, b)] -> Maybe b
`lookup` [(String, Options)]
classes of
Just Options
x -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. b -> Either a b
Right Options
x
Maybe Options
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ String
"Warning: The class "
forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show String
fClass
forall a. [a] -> [a] -> [a]
++ String
" is not defined."
uuagcBuildHook
:: ([String] -> FilePath -> IO (ExitCode, [FilePath]))
-> PackageDescription
-> LocalBuildInfo
-> UserHooks
-> BuildFlags
-> IO ()
uuagcBuildHook :: ([String] -> String -> IO (ExitCode, [String]))
-> PackageDescription
-> LocalBuildInfo
-> UserHooks
-> BuildFlags
-> IO ()
uuagcBuildHook [String] -> String -> IO (ExitCode, [String])
uuagc PackageDescription
pd LocalBuildInfo
lbi UserHooks
uh BuildFlags
bf = do
let classesPath :: String
classesPath = LocalBuildInfo -> String
buildDir LocalBuildInfo
lbi String -> String -> String
</> String
agClassesFile
([String] -> String -> IO (ExitCode, [String]))
-> String
-> PackageDescription
-> LocalBuildInfo
-> Flag Verbosity
-> IO ()
commonHook [String] -> String -> IO (ExitCode, [String])
uuagc String
classesPath PackageDescription
pd LocalBuildInfo
lbi (BuildFlags -> Flag Verbosity
buildVerbosity BuildFlags
bf)
PackageDescription
-> LocalBuildInfo -> UserHooks -> BuildFlags -> IO ()
originalBuildHook PackageDescription
pd LocalBuildInfo
lbi UserHooks
uh BuildFlags
bf
commonHook :: ([String] -> FilePath -> IO (ExitCode, [FilePath]))
-> FilePath
-> PackageDescription
-> LocalBuildInfo
-> Flag Verbosity
-> IO ()
commonHook :: ([String] -> String -> IO (ExitCode, [String]))
-> String
-> PackageDescription
-> LocalBuildInfo
-> Flag Verbosity
-> IO ()
commonHook [String] -> String -> IO (ExitCode, [String])
uuagc String
classesPath PackageDescription
pd LocalBuildInfo
lbi Flag Verbosity
fl = do
let verbosity :: Verbosity
verbosity = forall a. a -> Flag a -> a
fromFlagOrDefault Verbosity
normal Flag Verbosity
fl
Verbosity -> String -> IO ()
info Verbosity
verbosity forall a b. (a -> b) -> a -> b
$ String
"commonHook: Assuming AG classesPath: " forall a. [a] -> [a] -> [a]
++ String
classesPath
Verbosity -> Bool -> String -> IO ()
createDirectoryIfMissingVerbose Verbosity
verbosity Bool
True (LocalBuildInfo -> String
buildDir LocalBuildInfo
lbi)
Map String (Options, Maybe (String, [String]))
oldOptions <- String -> IO (Map String (Options, Maybe (String, [String])))
readFileOptions String
classesPath
let lib :: Maybe Library
lib = PackageDescription -> Maybe Library
library PackageDescription
pd
exes :: [Executable]
exes = PackageDescription -> [Executable]
executables PackageDescription
pd
bis :: [BuildInfo]
bis = forall a b. (a -> b) -> [a] -> [b]
map Library -> BuildInfo
libBuildInfo (forall a. Maybe a -> [a]
maybeToList Maybe Library
lib) forall a. [a] -> [a] -> [a]
++ forall a b. (a -> b) -> [a] -> [b]
map Executable -> BuildInfo
buildInfo [Executable]
exes
[(String, Options)]
classes <- forall a b. (a -> b) -> [a] -> [b]
map (AGOptionsClass -> String
className forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& AGOptionsClass -> Options
opts') forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` ([(String, String)] -> IO [AGOptionsClass]
getAGClasses forall b c a. (b -> c) -> (a -> b) -> a -> c
. PackageDescription -> [(String, String)]
customFieldsPD forall a b. (a -> b) -> a -> b
$ PackageDescription
pd)
AGFileOptions
configOptions <- [(String, String)] -> IO AGFileOptions
getAGFileOptions ([BuildInfo]
bis forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= BuildInfo -> [(String, String)]
customFieldsBI)
[(String, (Options, Maybe (String, [String])))]
newOptionsL <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM AGFileOptions
configOptions (\ AGFileOption
opt ->
let ([String]
notFound, Options
opts) = [(String, Options)] -> AGFileOption -> ([String], Options)
getOptionsFromClass [(String, Options)]
classes forall a b. (a -> b) -> a -> b
$ AGFileOption
opt
file :: String
file = String -> String
normalise forall a b. (a -> b) -> a -> b
$ AGFileOption -> String
filename AGFileOption
opt
gen :: Maybe (String, [String])
gen = forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. Maybe a
Nothing forall a b. (a, b) -> b
snd forall a b. (a -> b) -> a -> b
$ forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup String
file Map String (Options, Maybe (String, [String]))
oldOptions
in do Verbosity -> String -> IO ()
info Verbosity
verbosity forall a b. (a -> b) -> a -> b
$ String
"options for " forall a. [a] -> [a] -> [a]
++ String
file forall a. [a] -> [a] -> [a]
++ String
": " forall a. [a] -> [a] -> [a]
++ [String] -> String
unwords (Options -> [String]
optionsToString Options
opts)
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [String]
notFound (Handle -> String -> IO ()
hPutStrLn Handle
stderr)
forall (m :: * -> *) a. Monad m => a -> m a
return (String
file, (Options
opts, Maybe (String, [String])
gen)))
let newOptions :: Map String (Options, Maybe (String, [String]))
newOptions = forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [(String, (Options, Maybe (String, [String])))]
newOptionsL
String -> Map String (Options, Maybe (String, [String])) -> IO ()
writeFileOptions String
classesPath Map String (Options, Maybe (String, [String]))
newOptions
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (([String] -> String -> IO (ExitCode, [String]))
-> Map String (Options, Maybe (String, [String]))
-> (String, (Options, Maybe (String, [String])))
-> IO ()
updateAGFile [String] -> String -> IO (ExitCode, [String])
uuagc Map String (Options, Maybe (String, [String]))
newOptions) forall a b. (a -> b) -> a -> b
$ forall k a. Map k a -> [(k, a)]
Map.toList Map String (Options, Maybe (String, [String]))
oldOptions
getAGFileList :: AGFileOptions -> [FilePath]
getAGFileList :: AGFileOptions -> [String]
getAGFileList = forall a b. (a -> b) -> [a] -> [b]
map (String -> String
normalise forall b c a. (b -> c) -> (a -> b) -> a -> c
. AGFileOption -> String
filename)
uuagc :: BuildInfo -> LocalBuildInfo -> ComponentLocalBuildInfo -> PreProcessor
uuagc :: BuildInfo
-> LocalBuildInfo -> ComponentLocalBuildInfo -> PreProcessor
uuagc = ([String] -> String -> IO (ExitCode, [String]))
-> BuildInfo
-> LocalBuildInfo
-> ComponentLocalBuildInfo
-> PreProcessor
uuagc' (String -> [String] -> String -> IO (ExitCode, [String])
uuagcFromString String
uuagcn)
uuagc' :: ([String] -> FilePath -> IO (ExitCode, [FilePath]))
-> BuildInfo
-> LocalBuildInfo
-> ComponentLocalBuildInfo
-> PreProcessor
uuagc' :: ([String] -> String -> IO (ExitCode, [String]))
-> BuildInfo
-> LocalBuildInfo
-> ComponentLocalBuildInfo
-> PreProcessor
uuagc' [String] -> String -> IO (ExitCode, [String])
uuagc BuildInfo
build LocalBuildInfo
lbi ComponentLocalBuildInfo
_ =
PreProcessor {
#if MIN_VERSION_Cabal(3,8,1)
ppOrdering = \_verbosity _files modules -> pure modules,
#endif
platformIndependent :: Bool
platformIndependent = Bool
True,
runPreProcessor :: (String, String) -> (String, String) -> Verbosity -> IO ()
runPreProcessor = (String -> String -> Verbosity -> IO ())
-> (String, String) -> (String, String) -> Verbosity -> IO ()
mkSimplePreProcessor forall a b. (a -> b) -> a -> b
$ \ String
inFile String
outFile Verbosity
verbosity ->
do Verbosity -> String -> IO ()
notice Verbosity
verbosity forall a b. (a -> b) -> a -> b
$ String
"[UUAGC] processing: " forall a. [a] -> [a] -> [a]
++ String
inFile forall a. [a] -> [a] -> [a]
++ String
" generating: " forall a. [a] -> [a] -> [a]
++ String
outFile
let classesPath :: String
classesPath = LocalBuildInfo -> String
buildDir LocalBuildInfo
lbi String -> String -> String
</> String
agClassesFile
Verbosity -> String -> IO ()
info Verbosity
verbosity forall a b. (a -> b) -> a -> b
$ String
"uuagc-preprocessor: Assuming AG classesPath: " forall a. [a] -> [a] -> [a]
++ String
classesPath
Map String (Options, Maybe (String, [String]))
fileOpts <- String -> IO (Map String (Options, Maybe (String, [String])))
readFileOptions String
classesPath
Options
opts <- case forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup String
inFile Map String (Options, Maybe (String, [String]))
fileOpts of
Maybe (Options, Maybe (String, [String]))
Nothing -> do Verbosity -> String -> IO ()
warn Verbosity
verbosity forall a b. (a -> b) -> a -> b
$ String
"No options found for " forall a. [a] -> [a] -> [a]
++ String
inFile
forall (m :: * -> *) a. Monad m => a -> m a
return Options
noOptions
Just (Options
opt,Maybe (String, [String])
gen) -> forall (m :: * -> *) a. Monad m => a -> m a
return Options
opt
let search :: String
search = String -> String
dropFileName String
inFile
options :: Options
options = Options
opts { searchPath :: [String]
searchPath = String
search forall a. a -> [a] -> [a]
: [SymbolicPath PackageDir SourceDir] -> [String]
hsSourceDirsFilePaths (BuildInfo -> [SymbolicPath PackageDir SourceDir]
hsSourceDirs BuildInfo
build) forall a. [a] -> [a] -> [a]
++ Options -> [String]
searchPath Options
opts
, outputFiles :: [String]
outputFiles = String
outFile forall a. a -> [a] -> [a]
: (Options -> [String]
outputFiles Options
opts) }
(ExitCode
eCode,[String]
_) <- [String] -> String -> IO (ExitCode, [String])
uuagc (Options -> [String]
optionsToString Options
options) String
inFile
case ExitCode
eCode of
ExitCode
ExitSuccess -> String -> Map String (Options, Maybe (String, [String])) -> IO ()
writeFileOptions String
classesPath (forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert String
inFile (Options
opts, forall a. a -> Maybe a
Just (String
outFile, Options -> [String]
searchPath Options
options)) Map String (Options, Maybe (String, [String]))
fileOpts)
ex :: ExitCode
ex@(ExitFailure Int
_) -> forall e a. Exception e => e -> IO a
throwIO ExitCode
ex
}
#if MIN_VERSION_Cabal(3,6,0)
hsSourceDirsFilePaths :: [SymbolicPath PackageDir SourceDir] -> [FilePath]
hsSourceDirsFilePaths :: [SymbolicPath PackageDir SourceDir] -> [String]
hsSourceDirsFilePaths = forall a b. (a -> b) -> [a] -> [b]
map forall from to. SymbolicPath from to -> String
getSymbolicPath
#else
hsSourceDirsFilePaths :: [FilePath] -> [FilePath]
hsSourceDirsFilePaths = id
#endif
nouuagc :: BuildInfo -> LocalBuildInfo -> ComponentLocalBuildInfo -> PreProcessor
nouuagc :: BuildInfo
-> LocalBuildInfo -> ComponentLocalBuildInfo -> PreProcessor
nouuagc BuildInfo
build LocalBuildInfo
lbi ComponentLocalBuildInfo
_ =
PreProcessor {
#if MIN_VERSION_Cabal(3,8,1)
ppOrdering = \_verbosity _files modules -> pure modules,
#endif
platformIndependent :: Bool
platformIndependent = Bool
True,
runPreProcessor :: (String, String) -> (String, String) -> Verbosity -> IO ()
runPreProcessor = (String -> String -> Verbosity -> IO ())
-> (String, String) -> (String, String) -> Verbosity -> IO ()
mkSimplePreProcessor forall a b. (a -> b) -> a -> b
$ \String
inFile String
outFile Verbosity
verbosity -> do
Verbosity -> String -> IO ()
info Verbosity
verbosity (String
"skipping: " forall a. [a] -> [a] -> [a]
++ String
outFile)
}