{-# LANGUAGE MultiWayIf #-} module Build ( buildLibrary , buildProgram , buildWithScript ) where import Control.Applicative ( (<|>) ) import Control.Monad ( filterM ) import Data.Char ( isAsciiLower , isDigit , toLower ) import Data.List ( intercalate , isSuffixOf ) import Data.List.Utils (replace) import qualified Data.Map as Map import Data.Maybe ( fromMaybe , mapMaybe ) import Development.Shake ( FilePattern , Change(ChangeModtimeAndDigest) , cmd , getDirectoryFilesIO , liftIO , need , progressSimple , shake , shakeChange , shakeColor , shakeFiles , shakeOptions , shakeProgress , shakeThreads , want , () , (&%>) , (%>) , (?>) ) import Development.Shake.FilePath ( dropExtension , exe , makeRelative , () , (<.>) , (-<.>) ) import System.Directory ( createDirectoryIfMissing , makeAbsolute , withCurrentDirectory ) import System.Environment ( setEnv ) import System.FilePath ( splitDirectories ) import System.Process ( system ) import Text.ParserCombinators.ReadP ( ReadP , char , eof , many , many1 , option , readP_to_S , satisfy , skipSpaces , string ) type ModuleName = String data LineContents = ModuleUsed ModuleName | Other buildProgram :: FilePath -> [FilePath] -> [FilePattern] -> FilePath -> FilePath -> [String] -> String -> FilePath -> [FilePath] -> IO () buildProgram programDirectory libraryDirectories sourceExtensions buildDirectory compiler flags programName programSource archives = do sourceFiles <- getDirectoriesFiles [programDirectory] sourceExtensions canonicalProgramSource <- makeAbsolute $ programDirectory programSource moduleSourceFiles <- filterM (\source -> do canonicalSource <- makeAbsolute source return $ canonicalProgramSource /= canonicalSource ) sourceFiles let moduleObjectFiles = map (sourceFileToObjectFile buildDirectory programDirectory) moduleSourceFiles let sourceFileLookupMap = createSourceFileLookupMap buildDirectory programDirectory moduleSourceFiles let moduleLookupMap = createModuleLookupMap buildDirectory programDirectory moduleSourceFiles otherModuleMaps <- mapM getLibraryModuleMap libraryDirectories let allModuleMaps = moduleLookupMap `Map.union` foldl Map.union Map.empty otherModuleMaps let includeFlags = map ("-I" ++) libraryDirectories shake shakeOptions { shakeFiles = buildDirectory , shakeChange = ChangeModtimeAndDigest , shakeColor = True , shakeThreads = 0 , shakeProgress = progressSimple } $ do want [buildDirectory programName <.> exe] buildDirectory programName <.> exe %> \executable -> do let objectFile = sourceFileToObjectFile buildDirectory programDirectory programSource let allObjectFiles = objectFile : moduleObjectFiles need allObjectFiles need archives cmd compiler allObjectFiles archives ["-o", executable] flags buildDirectory programSource -<.> "o" %> \objectFile -> do let realObjectFile = foldl () "" $ splitDirectories objectFile let sourceFile = programDirectory programSource need [sourceFile] modulesUsed <- liftIO $ getModulesUsed sourceFile let moduleFilesNeeded = mapMaybe (`Map.lookup` allModuleMaps) modulesUsed let includeFlags = map ("-I" ++) libraryDirectories need moduleFilesNeeded cmd compiler ["-c", "-J" ++ buildDirectory] includeFlags flags ["-o", objectFile, sourceFile] map (\ext -> buildDirectory "*" <.> ext) ["o", "mod"] &%> \[objectFile, moduleFile] -> do let realObjectFile = foldl () "" $ splitDirectories objectFile let sourceFile = fromMaybe undefined (Map.lookup realObjectFile sourceFileLookupMap) need [sourceFile] modulesUsed <- liftIO $ getModulesUsed sourceFile let moduleFilesNeeded = mapMaybe (`Map.lookup` allModuleMaps) modulesUsed let includeFlags = map ("-I" ++) libraryDirectories need moduleFilesNeeded cmd compiler ["-c", "-J" ++ buildDirectory] includeFlags flags ["-o", objectFile, sourceFile] buildLibrary :: FilePath -> [FilePattern] -> FilePath -> FilePath -> [String] -> String -> [FilePath] -> IO (FilePath) buildLibrary libraryDirectory sourceExtensions buildDirectory compiler flags libraryName otherLibraryDirectories = do sourceFiles <- getDirectoriesFiles [libraryDirectory] sourceExtensions let sourceFileLookupMap = createSourceFileLookupMap buildDirectory libraryDirectory sourceFiles let moduleLookupMap = createModuleLookupMap buildDirectory libraryDirectory sourceFiles otherModuleMaps <- mapM getLibraryModuleMap otherLibraryDirectories let allModuleMaps = moduleLookupMap `Map.union` foldl Map.union Map.empty otherModuleMaps let archiveFile = buildDirectory "lib" ++ libraryName <.> "a" shake shakeOptions { shakeFiles = buildDirectory , shakeChange = ChangeModtimeAndDigest , shakeColor = True , shakeThreads = 0 , shakeProgress = progressSimple } $ do map (\ext -> buildDirectory "*" <.> ext) ["o", "mod"] &%> \[objectFile, moduleFile] -> do let realObjectFile = foldl () "" $ splitDirectories objectFile let sourceFile = fromMaybe undefined (Map.lookup realObjectFile sourceFileLookupMap) need [sourceFile] modulesUsed <- liftIO $ getModulesUsed sourceFile let moduleFilesNeeded = mapMaybe (`Map.lookup` allModuleMaps) modulesUsed let includeFlags = map ("-I" ++) otherLibraryDirectories need moduleFilesNeeded cmd compiler ["-c", "-J" ++ buildDirectory] includeFlags flags ["-o", objectFile, sourceFile] archiveFile %> \a -> do let objectFiles = Map.keys sourceFileLookupMap need objectFiles cmd "ar" ["rs"] a objectFiles want [archiveFile] return archiveFile -- A little wrapper around getDirectoryFiles so we can get files from multiple directories getDirectoriesFiles :: [FilePath] -> [FilePattern] -> IO [FilePath] getDirectoriesFiles dirs exts = getDirectoryFilesIO "" newPatterns where newPatterns = concatMap appendExts dirs appendExts dir = map ((dir "*") ++) exts getLibraryModuleMap :: FilePath -> IO (Map.Map ModuleName FilePath) getLibraryModuleMap libraryDirectory = do moduleFiles <- getDirectoriesFiles [libraryDirectory] ["*.mod"] let moduleMap = foldl Map.union Map.empty (map (\m -> Map.singleton (moduleFileToModuleName m) m) moduleFiles) return moduleMap where moduleFileToModuleName moduleFile = map toLower $ dropExtension (makeRelative libraryDirectory moduleFile) createSourceFileLookupMap :: FilePath -> FilePath -> [FilePath] -> Map.Map FilePath FilePath createSourceFileLookupMap buildDirectory libraryDirectory sourceFiles = foldl Map.union Map.empty (map (createSourceToObjectMap buildDirectory libraryDirectory) sourceFiles) createModuleLookupMap :: FilePath -> FilePath -> [FilePath] -> Map.Map ModuleName FilePath createModuleLookupMap buildDirectory libraryDirectory sourceFiles = foldl Map.union Map.empty (map (createSourceToModuleMap buildDirectory libraryDirectory) sourceFiles) createSourceToModuleMap :: FilePath -> FilePath -> FilePath -> Map.Map ModuleName FilePath createSourceToModuleMap buildDirectory libraryDirectory sourceFile = Map.singleton (sourceFileToModuleName libraryDirectory sourceFile) (sourceFileToModFile buildDirectory libraryDirectory sourceFile) sourceFileToModuleName :: FilePath -> FilePath -> ModuleName sourceFileToModuleName libraryDirectory sourceFile = map toLower $ pathSeparatorsToUnderscores (dropExtension (makeRelative libraryDirectory sourceFile)) createSourceToObjectMap :: FilePath -> FilePath -> FilePath -> Map.Map FilePath FilePath createSourceToObjectMap buildDirectory libraryDirectory sourceFile = Map.singleton (sourceFileToObjectFile buildDirectory libraryDirectory sourceFile) sourceFile sourceFileToObjectFile :: FilePath -> FilePath -> FilePath -> FilePath sourceFileToObjectFile buildDirectory libraryDirectory sourceFile = buildDirectory map toLower (pathSeparatorsToUnderscores (makeRelative libraryDirectory sourceFile) ) -<.> "o" sourceFileToExecutable :: FilePath -> FilePath -> FilePath -> FilePath sourceFileToExecutable buildDirectory appDirectory sourceFile = buildDirectory pathSeparatorsToUnderscores (makeRelative appDirectory sourceFile) -<.> exe sourceFileToModFile :: FilePath -> FilePath -> FilePath -> FilePath sourceFileToModFile buildDirectory libraryDirectory sourceFile = buildDirectory map toLower (pathSeparatorsToUnderscores (makeRelative libraryDirectory sourceFile) ) -<.> "mod" pathSeparatorsToUnderscores :: FilePath -> FilePath pathSeparatorsToUnderscores fileName = intercalate "_" (splitDirectories fileName) getModulesUsed :: FilePath -> IO [ModuleName] getModulesUsed sourceFile = do fileLines <- readFileLinesIO sourceFile let lineContents = map parseFortranLine fileLines return $ contentsToModuleNames lineContents contentsToModuleNames :: [LineContents] -> [ModuleName] contentsToModuleNames = mapMaybe contentToMaybeModuleName where contentToMaybeModuleName content = case content of ModuleUsed moduleName -> Just moduleName _ -> Nothing readFileLinesIO :: FilePath -> IO [String] readFileLinesIO file = do contents <- readFile file return $ lines contents parseFortranLine :: String -> LineContents parseFortranLine line = let line' = map toLower line result = readP_to_S doFortranLineParse line' in getResult result where getResult (_ : (contents, _) : _) = contents getResult [(contents, _) ] = contents getResult [] = Other doFortranLineParse :: ReadP LineContents doFortranLineParse = option Other fortranUsefulContents fortranUsefulContents :: ReadP LineContents fortranUsefulContents = useStatement useStatement :: ReadP LineContents useStatement = do skipSpaces _ <- string "use" skipAtLeastOneWhiteSpace modName <- validIdentifier skipSpaceCommaOrEnd return $ ModuleUsed modName skipAtLeastOneWhiteSpace :: ReadP () skipAtLeastOneWhiteSpace = do _ <- many1 whiteSpace return () skipSpaceOrEnd :: ReadP () skipSpaceOrEnd = eof <|> skipAtLeastOneWhiteSpace skipSpaceCommaOrEnd :: ReadP () skipSpaceCommaOrEnd = eof <|> skipComma <|> skipAtLeastOneWhiteSpace skipComma :: ReadP () skipComma = do _ <- char ',' return () whiteSpace :: ReadP Char whiteSpace = satisfy (`elem` " \t") validIdentifier :: ReadP String validIdentifier = do first <- validFirstCharacter rest <- many validIdentifierCharacter return $ first : rest validFirstCharacter :: ReadP Char validFirstCharacter = alphabet validIdentifierCharacter :: ReadP Char validIdentifierCharacter = alphabet <|> digit <|> underscore alphabet :: ReadP Char alphabet = satisfy isAsciiLower digit :: ReadP Char digit = satisfy isDigit underscore :: ReadP Char underscore = char '_' buildWithScript :: String -> FilePath -> FilePath -> FilePath -> [String] -> String -> [FilePath] -> IO (FilePath) buildWithScript script projectDirectory buildDirectory compiler flags libraryName otherLibraryDirectories = do absoluteBuildDirectory <- makeAbsolute buildDirectory createDirectoryIfMissing True absoluteBuildDirectory absoluteLibraryDirectories <- mapM makeAbsolute otherLibraryDirectories setEnv "FC" compiler setEnv "FFLAGS" (intercalate " " flags) setEnv "BUILD_DIR" (escapeColon absoluteBuildDirectory) setEnv "INCLUDE_DIRS" (intercalate " " absoluteLibraryDirectories) let archiveFile = absoluteBuildDirectory "lib" ++ libraryName <.> "a" withCurrentDirectory projectDirectory if | isMakefile script -> system ("make -f " ++ script ++ " " ++ archiveFile) | otherwise -> system (script ++ " " ++ archiveFile) return archiveFile isMakefile :: String -> Bool isMakefile script | script == "Makefile" = True | script == "makefile" = True | ".mk" `isSuffixOf` script = True | otherwise = False escapeColon :: String -> String escapeColon = replace ":" "\\:"