{-# 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
{-# DEPRECATED uuagcUserHook, uuagcUserHook', uuagc "Use uuagcLibUserHook instead" #-}
uuagcn :: [Char]
uuagcn = "uuagc"
defUUAGCOptions :: String
defUUAGCOptions :: [Char]
defUUAGCOptions = "uuagc_options"
agClassesFile :: String
agClassesFile :: [Char]
agClassesFile = "ag_file_options"
agModule :: String
agModule :: [Char]
agModule = "x-agmodule"
agClass :: String
agClass :: [Char]
agClass = "x-agclass"
uuagcUserHook :: UserHooks
uuagcUserHook :: UserHooks
uuagcUserHook = [Char] -> UserHooks
uuagcUserHook' [Char]
uuagcn
uuagcUserHook' :: String -> UserHooks
uuagcUserHook' :: [Char] -> UserHooks
uuagcUserHook' uuagcPath :: [Char]
uuagcPath = ([[Char]] -> [Char] -> IO (ExitCode, [[Char]])) -> UserHooks
uuagcLibUserHook ([Char] -> [[Char]] -> [Char] -> IO (ExitCode, [[Char]])
uuagcFromString [Char]
uuagcPath)
uuagcFromString :: String -> [String] -> FilePath -> IO (ExitCode, [FilePath])
uuagcFromString :: [Char] -> [[Char]] -> [Char] -> IO (ExitCode, [[Char]])
uuagcFromString uuagcPath :: [Char]
uuagcPath args :: [[Char]]
args file :: [Char]
file = do
(ec :: ExitCode
ec,out :: [Char]
out,err :: [Char]
err) <- [Char] -> [[Char]] -> [Char] -> IO (ExitCode, [Char], [Char])
readProcessWithExitCode [Char]
uuagcPath ([[Char]]
args [[Char]] -> [[Char]] -> [[Char]]
forall a. [a] -> [a] -> [a]
++ [[Char]
file]) ""
case ExitCode
ec of
ExitSuccess ->
do Handle -> [Char] -> IO ()
hPutStr Handle
stderr [Char]
err
(ExitCode, [[Char]]) -> IO (ExitCode, [[Char]])
forall (m :: * -> *) a. Monad m => a -> m a
return (ExitCode
ExitSuccess, [Char] -> [[Char]]
words [Char]
out)
(ExitFailure exc :: Int
exc) ->
do Handle -> [Char] -> IO ()
hPutStrLn Handle
stderr ([Char]
uuagcPath [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ ": " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show Int
exc)
Handle -> [Char] -> IO ()
hPutStr Handle
stderr [Char]
out
Handle -> [Char] -> IO ()
hPutStr Handle
stderr [Char]
err
(ExitCode, [[Char]]) -> IO (ExitCode, [[Char]])
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> ExitCode
ExitFailure Int
exc, [])
uuagcLibUserHook :: ([String] -> FilePath -> IO (ExitCode, [FilePath])) -> UserHooks
uuagcLibUserHook :: ([[Char]] -> [Char] -> IO (ExitCode, [[Char]])) -> UserHooks
uuagcLibUserHook uuagc :: [[Char]] -> [Char] -> IO (ExitCode, [[Char]])
uuagc = UserHooks
hooks where
hooks :: UserHooks
hooks = UserHooks
simpleUserHooks { hookedPreProcessors :: [PPSuffixHandler]
hookedPreProcessors = ("ag", BuildInfo
-> LocalBuildInfo -> ComponentLocalBuildInfo -> PreProcessor
ag)PPSuffixHandler -> [PPSuffixHandler] -> [PPSuffixHandler]
forall a. a -> [a] -> [a]
:("lag",BuildInfo
-> LocalBuildInfo -> ComponentLocalBuildInfo -> PreProcessor
ag)PPSuffixHandler -> [PPSuffixHandler] -> [PPSuffixHandler]
forall a. a -> [a] -> [a]
:[PPSuffixHandler]
knownSuffixHandlers
, buildHook :: PackageDescription
-> LocalBuildInfo -> UserHooks -> BuildFlags -> IO ()
buildHook = ([[Char]] -> [Char] -> IO (ExitCode, [[Char]]))
-> PackageDescription
-> LocalBuildInfo
-> UserHooks
-> BuildFlags
-> IO ()
uuagcBuildHook [[Char]] -> [Char] -> IO (ExitCode, [[Char]])
uuagc
}
ag :: BuildInfo
-> LocalBuildInfo -> ComponentLocalBuildInfo -> PreProcessor
ag = ([[Char]] -> [Char] -> IO (ExitCode, [[Char]]))
-> BuildInfo
-> LocalBuildInfo
-> ComponentLocalBuildInfo
-> PreProcessor
uuagc' [[Char]] -> [Char] -> IO (ExitCode, [[Char]])
uuagc
originalPreBuild :: [[Char]] -> BuildFlags -> IO HookedBuildInfo
originalPreBuild = UserHooks -> [[Char]] -> 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 h :: Handle
h = Handle -> IO [Char]
hGetContents Handle
h IO [Char] -> ([Char] -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Handle -> [Char] -> IO ()
hPutStr Handle
stderr
updateAGFile :: ([String] -> FilePath -> IO (ExitCode, [FilePath]))
-> Map FilePath (Options, Maybe (FilePath, [String]))
-> (FilePath, (Options, Maybe (FilePath, [String])))
-> IO ()
updateAGFile :: ([[Char]] -> [Char] -> IO (ExitCode, [[Char]]))
-> Map [Char] (Options, Maybe ([Char], [[Char]]))
-> ([Char], (Options, Maybe ([Char], [[Char]])))
-> IO ()
updateAGFile _ _ (_,(_,Nothing)) = () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
updateAGFile uuagc :: [[Char]] -> [Char] -> IO (ExitCode, [[Char]])
uuagc newOptions :: Map [Char] (Options, Maybe ([Char], [[Char]]))
newOptions (file :: [Char]
file,(opts :: Options
opts,Just (gen :: [Char]
gen,sp :: [[Char]]
sp))) = do
Bool
hasGen <- [Char] -> IO Bool
doesFileExist [Char]
gen
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
hasGen (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
(ec :: ExitCode
ec, files :: [[Char]]
files) <- [[Char]] -> [Char] -> IO (ExitCode, [[Char]])
uuagc (Options -> [[Char]]
optionsToString (Options -> [[Char]]) -> Options -> [[Char]]
forall a b. (a -> b) -> a -> b
$ Options
opts { genFileDeps :: Bool
genFileDeps = Bool
True, searchPath :: [[Char]]
searchPath = [[Char]]
sp }) [Char]
file
case ExitCode
ec of
ExitSuccess -> do
let newOpts :: Options
newOpts :: Options
newOpts = Options
-> ((Options, Maybe ([Char], [[Char]])) -> Options)
-> Maybe (Options, Maybe ([Char], [[Char]]))
-> Options
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Options
noOptions (Options, Maybe ([Char], [[Char]])) -> Options
forall a b. (a, b) -> a
fst (Maybe (Options, Maybe ([Char], [[Char]])) -> Options)
-> Maybe (Options, Maybe ([Char], [[Char]])) -> Options
forall a b. (a -> b) -> a -> b
$ [Char]
-> Map [Char] (Options, Maybe ([Char], [[Char]]))
-> Maybe (Options, Maybe ([Char], [[Char]]))
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup [Char]
file Map [Char] (Options, Maybe ([Char], [[Char]]))
newOptions
optRebuild :: Bool
optRebuild = Options -> [[Char]]
optionsToString Options
newOpts [[Char]] -> [[Char]] -> Bool
forall a. Eq a => a -> a -> Bool
/= Options -> [[Char]]
optionsToString Options
opts
Bool
modRebuild <-
if [[Char]] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [[Char]]
files
then Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
else do
[UTCTime]
flsmt <- ([Char] -> IO UTCTime) -> [[Char]] -> IO [UTCTime]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM [Char] -> IO UTCTime
getModificationTime [[Char]]
files
let maxModified :: UTCTime
maxModified = [UTCTime] -> UTCTime
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum [UTCTime]
flsmt
UTCTime
fmt <- [Char] -> IO UTCTime
getModificationTime [Char]
gen
Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> IO Bool) -> Bool -> IO Bool
forall a b. (a -> b) -> a -> b
$ UTCTime
maxModified UTCTime -> UTCTime -> Bool
forall a. Ord a => a -> a -> Bool
> UTCTime
fmt
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool
optRebuild Bool -> Bool -> Bool
|| Bool
modRebuild) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char] -> IO ()
removeFile [Char]
gen
ex :: ExitCode
ex@(ExitFailure _) -> ExitCode -> IO ()
forall e a. Exception e => e -> IO a
throwIO ExitCode
ex
getAGFileOptions :: [(String, String)] -> IO AGFileOptions
getAGFileOptions :: [([Char], [Char])] -> IO AGFileOptions
getAGFileOptions extra :: [([Char], [Char])]
extra = do
AGFileOptions
cabalOpts <- (([Char], [Char]) -> IO AGFileOption)
-> [([Char], [Char])] -> IO AGFileOptions
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ([Char] -> IO AGFileOption
parseOptionAG ([Char] -> IO AGFileOption)
-> (([Char], [Char]) -> [Char])
-> ([Char], [Char])
-> IO AGFileOption
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Char], [Char]) -> [Char]
forall a b. (a, b) -> b
snd) ([([Char], [Char])] -> IO AGFileOptions)
-> [([Char], [Char])] -> IO AGFileOptions
forall a b. (a -> b) -> a -> b
$ (([Char], [Char]) -> Bool)
-> [([Char], [Char])] -> [([Char], [Char])]
forall a. (a -> Bool) -> [a] -> [a]
filter (([Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== [Char]
agModule) ([Char] -> Bool)
-> (([Char], [Char]) -> [Char]) -> ([Char], [Char]) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Char], [Char]) -> [Char]
forall a b. (a, b) -> a
fst) [([Char], [Char])]
extra
Bool
usesOptionsFile <- [Char] -> IO Bool
doesFileExist [Char]
defUUAGCOptions
if Bool
usesOptionsFile
then do Either ParserError AGFileOptions
r <- [Char] -> IO (Either ParserError AGFileOptions)
parserAG' [Char]
defUUAGCOptions
case Either ParserError AGFileOptions
r of
Left e :: ParserError
e -> [Char] -> IO AGFileOptions
forall a. [Char] -> IO a
dieNoVerbosity (ParserError -> [Char]
forall a. Show a => a -> [Char]
show ParserError
e)
Right a :: AGFileOptions
a -> AGFileOptions -> IO AGFileOptions
forall (m :: * -> *) a. Monad m => a -> m a
return (AGFileOptions -> IO AGFileOptions)
-> AGFileOptions -> IO AGFileOptions
forall a b. (a -> b) -> a -> b
$ AGFileOptions
cabalOpts AGFileOptions -> AGFileOptions -> AGFileOptions
forall a. [a] -> [a] -> [a]
++ AGFileOptions
a
else AGFileOptions -> IO AGFileOptions
forall (m :: * -> *) a. Monad m => a -> m a
return AGFileOptions
cabalOpts
getAGClasses :: [(String, String)] -> IO [AGOptionsClass]
getAGClasses :: [([Char], [Char])] -> IO [AGOptionsClass]
getAGClasses = (([Char], [Char]) -> IO AGOptionsClass)
-> [([Char], [Char])] -> IO [AGOptionsClass]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ([Char] -> IO AGOptionsClass
parseClassAG ([Char] -> IO AGOptionsClass)
-> (([Char], [Char]) -> [Char])
-> ([Char], [Char])
-> IO AGOptionsClass
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Char], [Char]) -> [Char]
forall a b. (a, b) -> b
snd) ([([Char], [Char])] -> IO [AGOptionsClass])
-> ([([Char], [Char])] -> [([Char], [Char])])
-> [([Char], [Char])]
-> IO [AGOptionsClass]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (([Char], [Char]) -> Bool)
-> [([Char], [Char])] -> [([Char], [Char])]
forall a. (a -> Bool) -> [a] -> [a]
filter (([Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== [Char]
agClass) ([Char] -> Bool)
-> (([Char], [Char]) -> [Char]) -> ([Char], [Char]) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Char], [Char]) -> [Char]
forall a b. (a, b) -> a
fst)
writeFileOptions :: FilePath -> Map FilePath (Options, Maybe (FilePath,[String])) -> IO ()
writeFileOptions :: [Char] -> Map [Char] (Options, Maybe ([Char], [[Char]])) -> IO ()
writeFileOptions classesPath :: [Char]
classesPath opts :: Map [Char] (Options, Maybe ([Char], [[Char]]))
opts = do
Handle
hClasses <- [Char] -> IOMode -> IO Handle
openFile [Char]
classesPath IOMode
WriteMode
Handle -> [Char] -> IO ()
hPutStr Handle
hClasses ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$ Map [Char] ([[Char]], Maybe ([Char], [[Char]])) -> [Char]
forall a. Show a => a -> [Char]
show (Map [Char] ([[Char]], Maybe ([Char], [[Char]])) -> [Char])
-> Map [Char] ([[Char]], Maybe ([Char], [[Char]])) -> [Char]
forall a b. (a -> b) -> a -> b
$ ((Options, Maybe ([Char], [[Char]]))
-> ([[Char]], Maybe ([Char], [[Char]])))
-> Map [Char] (Options, Maybe ([Char], [[Char]]))
-> Map [Char] ([[Char]], Maybe ([Char], [[Char]]))
forall a b k. (a -> b) -> Map k a -> Map k b
Map.map (\(opt :: Options
opt,gen :: Maybe ([Char], [[Char]])
gen) -> (Options -> [[Char]]
optionsToString Options
opt, Maybe ([Char], [[Char]])
gen)) Map [Char] (Options, Maybe ([Char], [[Char]]))
opts
Handle -> IO ()
hFlush Handle
hClasses
Handle -> IO ()
hClose Handle
hClasses
readFileOptions :: FilePath -> IO (Map FilePath (Options, Maybe (FilePath,[String])))
readFileOptions :: [Char] -> IO (Map [Char] (Options, Maybe ([Char], [[Char]])))
readFileOptions classesPath :: [Char]
classesPath = do
Bool
isFile <- [Char] -> IO Bool
doesFileExist [Char]
classesPath
if Bool
isFile
then do Handle
hClasses <- [Char] -> IOMode -> IO Handle
openFile [Char]
classesPath IOMode
ReadMode
[Char]
sClasses <- Handle -> IO [Char]
hGetContents Handle
hClasses
Map [Char] ([[Char]], Maybe ([Char], [[Char]]))
classes <- [Char] -> IO (Map [Char] ([[Char]], Maybe ([Char], [[Char]])))
forall a. Read a => [Char] -> IO a
readIO [Char]
sClasses :: IO (Map FilePath ([String], Maybe (FilePath,[String])))
Handle -> IO ()
hClose Handle
hClasses
Map [Char] (Options, Maybe ([Char], [[Char]]))
-> IO (Map [Char] (Options, Maybe ([Char], [[Char]])))
forall (m :: * -> *) a. Monad m => a -> m a
return (Map [Char] (Options, Maybe ([Char], [[Char]]))
-> IO (Map [Char] (Options, Maybe ([Char], [[Char]]))))
-> Map [Char] (Options, Maybe ([Char], [[Char]]))
-> IO (Map [Char] (Options, Maybe ([Char], [[Char]])))
forall a b. (a -> b) -> a -> b
$ (([[Char]], Maybe ([Char], [[Char]]))
-> (Options, Maybe ([Char], [[Char]])))
-> Map [Char] ([[Char]], Maybe ([Char], [[Char]]))
-> Map [Char] (Options, Maybe ([Char], [[Char]]))
forall a b k. (a -> b) -> Map k a -> Map k b
Map.map (\(opt :: [[Char]]
opt,gen :: Maybe ([Char], [[Char]])
gen) -> let (opt' :: Options
opt',_,_) = [[Char]] -> (Options, [[Char]], [[Char]])
getOptions [[Char]]
opt in (Options
opt', Maybe ([Char], [[Char]])
gen)) Map [Char] ([[Char]], Maybe ([Char], [[Char]]))
classes
else Map [Char] (Options, Maybe ([Char], [[Char]]))
-> IO (Map [Char] (Options, Maybe ([Char], [[Char]])))
forall (m :: * -> *) a. Monad m => a -> m a
return Map [Char] (Options, Maybe ([Char], [[Char]]))
forall k a. Map k a
Map.empty
getOptionsFromClass :: [(String, Options)] -> AGFileOption -> ([String], Options)
getOptionsFromClass :: [([Char], Options)] -> AGFileOption -> ([[Char]], Options)
getOptionsFromClass classes :: [([Char], Options)]
classes fOpt :: AGFileOption
fOpt =
([Options] -> Options)
-> ([[Char]], [Options]) -> ([[Char]], Options)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second ((Options -> Options -> Options) -> Options -> [Options] -> Options
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl Options -> Options -> Options
combineOptions (AGFileOption -> Options
opts AGFileOption
fOpt))
(([[Char]], [Options]) -> ([[Char]], Options))
-> ([Either [Char] Options] -> ([[Char]], [Options]))
-> [Either [Char] Options]
-> ([[Char]], Options)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Either [Char] Options] -> ([[Char]], [Options])
forall a b. [Either a b] -> ([a], [b])
partitionEithers ([Either [Char] Options] -> ([[Char]], Options))
-> [Either [Char] Options] -> ([[Char]], Options)
forall a b. (a -> b) -> a -> b
$ do
[Char]
fClass <- AGFileOption -> [[Char]]
fileClasses AGFileOption
fOpt
case [Char]
fClass [Char] -> [([Char], Options)] -> Maybe Options
forall a b. Eq a => a -> [(a, b)] -> Maybe b
`lookup` [([Char], Options)]
classes of
Just x :: Options
x -> Either [Char] Options -> [Either [Char] Options]
forall (m :: * -> *) a. Monad m => a -> m a
return (Either [Char] Options -> [Either [Char] Options])
-> Either [Char] Options -> [Either [Char] Options]
forall a b. (a -> b) -> a -> b
$ Options -> Either [Char] Options
forall a b. b -> Either a b
Right Options
x
Nothing -> Either [Char] Options -> [Either [Char] Options]
forall (m :: * -> *) a. Monad m => a -> m a
return (Either [Char] Options -> [Either [Char] Options])
-> Either [Char] Options -> [Either [Char] Options]
forall a b. (a -> b) -> a -> b
$ [Char] -> Either [Char] Options
forall a b. a -> Either a b
Left ([Char] -> Either [Char] Options)
-> [Char] -> Either [Char] Options
forall a b. (a -> b) -> a -> b
$ "Warning: The class "
[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char] -> [Char]
forall a. Show a => a -> [Char]
show [Char]
fClass
[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ " is not defined."
uuagcBuildHook
:: ([String] -> FilePath -> IO (ExitCode, [FilePath]))
-> PackageDescription
-> LocalBuildInfo
-> UserHooks
-> BuildFlags
-> IO ()
uuagcBuildHook :: ([[Char]] -> [Char] -> IO (ExitCode, [[Char]]))
-> PackageDescription
-> LocalBuildInfo
-> UserHooks
-> BuildFlags
-> IO ()
uuagcBuildHook uuagc :: [[Char]] -> [Char] -> IO (ExitCode, [[Char]])
uuagc pd :: PackageDescription
pd lbi :: LocalBuildInfo
lbi uh :: UserHooks
uh bf :: BuildFlags
bf = do
let classesPath :: [Char]
classesPath = LocalBuildInfo -> [Char]
buildDir LocalBuildInfo
lbi [Char] -> [Char] -> [Char]
</> [Char]
agClassesFile
([[Char]] -> [Char] -> IO (ExitCode, [[Char]]))
-> [Char]
-> PackageDescription
-> LocalBuildInfo
-> Flag Verbosity
-> IO ()
commonHook [[Char]] -> [Char] -> IO (ExitCode, [[Char]])
uuagc [Char]
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 :: ([[Char]] -> [Char] -> IO (ExitCode, [[Char]]))
-> [Char]
-> PackageDescription
-> LocalBuildInfo
-> Flag Verbosity
-> IO ()
commonHook uuagc :: [[Char]] -> [Char] -> IO (ExitCode, [[Char]])
uuagc classesPath :: [Char]
classesPath pd :: PackageDescription
pd lbi :: LocalBuildInfo
lbi fl :: Flag Verbosity
fl = do
let verbosity :: Verbosity
verbosity = Verbosity -> Flag Verbosity -> Verbosity
forall a. a -> Flag a -> a
fromFlagOrDefault Verbosity
normal Flag Verbosity
fl
Verbosity -> [Char] -> IO ()
info Verbosity
verbosity ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$ "commonHook: Assuming AG classesPath: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
classesPath
Verbosity -> Bool -> [Char] -> IO ()
createDirectoryIfMissingVerbose Verbosity
verbosity Bool
True (LocalBuildInfo -> [Char]
buildDir LocalBuildInfo
lbi)
Map [Char] (Options, Maybe ([Char], [[Char]]))
oldOptions <- [Char] -> IO (Map [Char] (Options, Maybe ([Char], [[Char]])))
readFileOptions [Char]
classesPath
let lib :: Maybe Library
lib = PackageDescription -> Maybe Library
library PackageDescription
pd
exes :: [Executable]
exes = PackageDescription -> [Executable]
executables PackageDescription
pd
bis :: [BuildInfo]
bis = (Library -> BuildInfo) -> [Library] -> [BuildInfo]
forall a b. (a -> b) -> [a] -> [b]
map Library -> BuildInfo
libBuildInfo (Maybe Library -> [Library]
forall a. Maybe a -> [a]
maybeToList Maybe Library
lib) [BuildInfo] -> [BuildInfo] -> [BuildInfo]
forall a. [a] -> [a] -> [a]
++ (Executable -> BuildInfo) -> [Executable] -> [BuildInfo]
forall a b. (a -> b) -> [a] -> [b]
map Executable -> BuildInfo
buildInfo [Executable]
exes
[([Char], Options)]
classes <- (AGOptionsClass -> ([Char], Options))
-> [AGOptionsClass] -> [([Char], Options)]
forall a b. (a -> b) -> [a] -> [b]
map (AGOptionsClass -> [Char]
className (AGOptionsClass -> [Char])
-> (AGOptionsClass -> Options)
-> AGOptionsClass
-> ([Char], Options)
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& AGOptionsClass -> Options
opts') ([AGOptionsClass] -> [([Char], Options)])
-> IO [AGOptionsClass] -> IO [([Char], Options)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` ([([Char], [Char])] -> IO [AGOptionsClass]
getAGClasses ([([Char], [Char])] -> IO [AGOptionsClass])
-> (PackageDescription -> [([Char], [Char])])
-> PackageDescription
-> IO [AGOptionsClass]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PackageDescription -> [([Char], [Char])]
customFieldsPD (PackageDescription -> IO [AGOptionsClass])
-> PackageDescription -> IO [AGOptionsClass]
forall a b. (a -> b) -> a -> b
$ PackageDescription
pd)
AGFileOptions
configOptions <- [([Char], [Char])] -> IO AGFileOptions
getAGFileOptions ([BuildInfo]
bis [BuildInfo]
-> (BuildInfo -> [([Char], [Char])]) -> [([Char], [Char])]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= BuildInfo -> [([Char], [Char])]
customFieldsBI)
[([Char], (Options, Maybe ([Char], [[Char]])))]
newOptionsL <- AGFileOptions
-> (AGFileOption
-> IO ([Char], (Options, Maybe ([Char], [[Char]]))))
-> IO [([Char], (Options, Maybe ([Char], [[Char]])))]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM AGFileOptions
configOptions (\ opt :: AGFileOption
opt ->
let (notFound :: [[Char]]
notFound, opts :: Options
opts) = [([Char], Options)] -> AGFileOption -> ([[Char]], Options)
getOptionsFromClass [([Char], Options)]
classes (AGFileOption -> ([[Char]], Options))
-> AGFileOption -> ([[Char]], Options)
forall a b. (a -> b) -> a -> b
$ AGFileOption
opt
file :: [Char]
file = [Char] -> [Char]
normalise ([Char] -> [Char]) -> [Char] -> [Char]
forall a b. (a -> b) -> a -> b
$ AGFileOption -> [Char]
filename AGFileOption
opt
gen :: Maybe ([Char], [[Char]])
gen = Maybe ([Char], [[Char]])
-> ((Options, Maybe ([Char], [[Char]]))
-> Maybe ([Char], [[Char]]))
-> Maybe (Options, Maybe ([Char], [[Char]]))
-> Maybe ([Char], [[Char]])
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Maybe ([Char], [[Char]])
forall a. Maybe a
Nothing (Options, Maybe ([Char], [[Char]])) -> Maybe ([Char], [[Char]])
forall a b. (a, b) -> b
snd (Maybe (Options, Maybe ([Char], [[Char]]))
-> Maybe ([Char], [[Char]]))
-> Maybe (Options, Maybe ([Char], [[Char]]))
-> Maybe ([Char], [[Char]])
forall a b. (a -> b) -> a -> b
$ [Char]
-> Map [Char] (Options, Maybe ([Char], [[Char]]))
-> Maybe (Options, Maybe ([Char], [[Char]]))
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup [Char]
file Map [Char] (Options, Maybe ([Char], [[Char]]))
oldOptions
in do Verbosity -> [Char] -> IO ()
info Verbosity
verbosity ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$ "options for " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
file [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ ": " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [[Char]] -> [Char]
unwords (Options -> [[Char]]
optionsToString Options
opts)
[[Char]] -> ([Char] -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [[Char]]
notFound (Handle -> [Char] -> IO ()
hPutStrLn Handle
stderr)
([Char], (Options, Maybe ([Char], [[Char]])))
-> IO ([Char], (Options, Maybe ([Char], [[Char]])))
forall (m :: * -> *) a. Monad m => a -> m a
return ([Char]
file, (Options
opts, Maybe ([Char], [[Char]])
gen)))
let newOptions :: Map [Char] (Options, Maybe ([Char], [[Char]]))
newOptions = [([Char], (Options, Maybe ([Char], [[Char]])))]
-> Map [Char] (Options, Maybe ([Char], [[Char]]))
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [([Char], (Options, Maybe ([Char], [[Char]])))]
newOptionsL
[Char] -> Map [Char] (Options, Maybe ([Char], [[Char]])) -> IO ()
writeFileOptions [Char]
classesPath Map [Char] (Options, Maybe ([Char], [[Char]]))
newOptions
(([Char], (Options, Maybe ([Char], [[Char]]))) -> IO ())
-> [([Char], (Options, Maybe ([Char], [[Char]])))] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (([[Char]] -> [Char] -> IO (ExitCode, [[Char]]))
-> Map [Char] (Options, Maybe ([Char], [[Char]]))
-> ([Char], (Options, Maybe ([Char], [[Char]])))
-> IO ()
updateAGFile [[Char]] -> [Char] -> IO (ExitCode, [[Char]])
uuagc Map [Char] (Options, Maybe ([Char], [[Char]]))
newOptions) ([([Char], (Options, Maybe ([Char], [[Char]])))] -> IO ())
-> [([Char], (Options, Maybe ([Char], [[Char]])))] -> IO ()
forall a b. (a -> b) -> a -> b
$ Map [Char] (Options, Maybe ([Char], [[Char]]))
-> [([Char], (Options, Maybe ([Char], [[Char]])))]
forall k a. Map k a -> [(k, a)]
Map.toList Map [Char] (Options, Maybe ([Char], [[Char]]))
oldOptions
getAGFileList :: AGFileOptions -> [FilePath]
getAGFileList :: AGFileOptions -> [[Char]]
getAGFileList = (AGFileOption -> [Char]) -> AGFileOptions -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map ([Char] -> [Char]
normalise ([Char] -> [Char])
-> (AGFileOption -> [Char]) -> AGFileOption -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AGFileOption -> [Char]
filename)
uuagc :: BuildInfo -> LocalBuildInfo -> ComponentLocalBuildInfo -> PreProcessor
uuagc :: BuildInfo
-> LocalBuildInfo -> ComponentLocalBuildInfo -> PreProcessor
uuagc = ([[Char]] -> [Char] -> IO (ExitCode, [[Char]]))
-> BuildInfo
-> LocalBuildInfo
-> ComponentLocalBuildInfo
-> PreProcessor
uuagc' ([Char] -> [[Char]] -> [Char] -> IO (ExitCode, [[Char]])
uuagcFromString [Char]
uuagcn)
uuagc' :: ([String] -> FilePath -> IO (ExitCode, [FilePath]))
-> BuildInfo
-> LocalBuildInfo
-> ComponentLocalBuildInfo
-> PreProcessor
uuagc' :: ([[Char]] -> [Char] -> IO (ExitCode, [[Char]]))
-> BuildInfo
-> LocalBuildInfo
-> ComponentLocalBuildInfo
-> PreProcessor
uuagc' uuagc :: [[Char]] -> [Char] -> IO (ExitCode, [[Char]])
uuagc build :: BuildInfo
build lbi :: LocalBuildInfo
lbi _ =
PreProcessor :: Bool
-> (([Char], [Char]) -> ([Char], [Char]) -> Verbosity -> IO ())
-> PreProcessor
PreProcessor {
platformIndependent :: Bool
platformIndependent = Bool
True,
runPreProcessor :: ([Char], [Char]) -> ([Char], [Char]) -> Verbosity -> IO ()
runPreProcessor = ([Char] -> [Char] -> Verbosity -> IO ())
-> ([Char], [Char]) -> ([Char], [Char]) -> Verbosity -> IO ()
([Char] -> [Char] -> Verbosity -> IO ())
-> ([Char], [Char]) -> ([Char], [Char]) -> Verbosity -> IO ()
mkSimplePreProcessor (([Char] -> [Char] -> Verbosity -> IO ())
-> ([Char], [Char]) -> ([Char], [Char]) -> Verbosity -> IO ())
-> ([Char] -> [Char] -> Verbosity -> IO ())
-> ([Char], [Char])
-> ([Char], [Char])
-> Verbosity
-> IO ()
forall a b. (a -> b) -> a -> b
$ \ inFile :: [Char]
inFile outFile :: [Char]
outFile verbosity :: Verbosity
verbosity ->
do Verbosity -> [Char] -> IO ()
notice Verbosity
verbosity ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$ "[UUAGC] processing: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
inFile [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ " generating: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
outFile
let classesPath :: [Char]
classesPath = LocalBuildInfo -> [Char]
buildDir LocalBuildInfo
lbi [Char] -> [Char] -> [Char]
</> [Char]
agClassesFile
Verbosity -> [Char] -> IO ()
info Verbosity
verbosity ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$ "uuagc-preprocessor: Assuming AG classesPath: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
classesPath
Map [Char] (Options, Maybe ([Char], [[Char]]))
fileOpts <- [Char] -> IO (Map [Char] (Options, Maybe ([Char], [[Char]])))
readFileOptions [Char]
classesPath
Options
opts <- case [Char]
-> Map [Char] (Options, Maybe ([Char], [[Char]]))
-> Maybe (Options, Maybe ([Char], [[Char]]))
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup [Char]
inFile Map [Char] (Options, Maybe ([Char], [[Char]]))
fileOpts of
Nothing -> do Verbosity -> [Char] -> IO ()
warn Verbosity
verbosity ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$ "No options found for " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
inFile
Options -> IO Options
forall (m :: * -> *) a. Monad m => a -> m a
return Options
noOptions
Just (opt :: Options
opt,gen :: Maybe ([Char], [[Char]])
gen) -> Options -> IO Options
forall (m :: * -> *) a. Monad m => a -> m a
return Options
opt
let search :: [Char]
search = [Char] -> [Char]
dropFileName [Char]
inFile
options :: Options
options = Options
opts { searchPath :: [[Char]]
searchPath = [Char]
search [Char] -> [[Char]] -> [[Char]]
forall a. a -> [a] -> [a]
: BuildInfo -> [[Char]]
hsSourceDirs BuildInfo
build [[Char]] -> [[Char]] -> [[Char]]
forall a. [a] -> [a] -> [a]
++ Options -> [[Char]]
searchPath Options
opts
, outputFiles :: [[Char]]
outputFiles = [Char]
outFile [Char] -> [[Char]] -> [[Char]]
forall a. a -> [a] -> [a]
: (Options -> [[Char]]
outputFiles Options
opts) }
(eCode :: ExitCode
eCode,_) <- [[Char]] -> [Char] -> IO (ExitCode, [[Char]])
uuagc (Options -> [[Char]]
optionsToString Options
options) [Char]
inFile
case ExitCode
eCode of
ExitSuccess -> [Char] -> Map [Char] (Options, Maybe ([Char], [[Char]])) -> IO ()
writeFileOptions [Char]
classesPath ([Char]
-> (Options, Maybe ([Char], [[Char]]))
-> Map [Char] (Options, Maybe ([Char], [[Char]]))
-> Map [Char] (Options, Maybe ([Char], [[Char]]))
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert [Char]
inFile (Options
opts, ([Char], [[Char]]) -> Maybe ([Char], [[Char]])
forall a. a -> Maybe a
Just ([Char]
outFile, Options -> [[Char]]
searchPath Options
options)) Map [Char] (Options, Maybe ([Char], [[Char]]))
fileOpts)
ex :: ExitCode
ex@(ExitFailure _) -> ExitCode -> IO ()
forall e a. Exception e => e -> IO a
throwIO ExitCode
ex
}
nouuagc :: BuildInfo -> LocalBuildInfo -> ComponentLocalBuildInfo -> PreProcessor
nouuagc :: BuildInfo
-> LocalBuildInfo -> ComponentLocalBuildInfo -> PreProcessor
nouuagc build :: BuildInfo
build lbi :: LocalBuildInfo
lbi _ =
PreProcessor :: Bool
-> (([Char], [Char]) -> ([Char], [Char]) -> Verbosity -> IO ())
-> PreProcessor
PreProcessor {
platformIndependent :: Bool
platformIndependent = Bool
True,
runPreProcessor :: ([Char], [Char]) -> ([Char], [Char]) -> Verbosity -> IO ()
runPreProcessor = ([Char] -> [Char] -> Verbosity -> IO ())
-> ([Char], [Char]) -> ([Char], [Char]) -> Verbosity -> IO ()
([Char] -> [Char] -> Verbosity -> IO ())
-> ([Char], [Char]) -> ([Char], [Char]) -> Verbosity -> IO ()
mkSimplePreProcessor (([Char] -> [Char] -> Verbosity -> IO ())
-> ([Char], [Char]) -> ([Char], [Char]) -> Verbosity -> IO ())
-> ([Char] -> [Char] -> Verbosity -> IO ())
-> ([Char], [Char])
-> ([Char], [Char])
-> Verbosity
-> IO ()
forall a b. (a -> b) -> a -> b
$ \inFile :: [Char]
inFile outFile :: [Char]
outFile verbosity :: Verbosity
verbosity -> do
Verbosity -> [Char] -> IO ()
info Verbosity
verbosity ("skipping: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
outFile)
}