diff options
Diffstat (limited to 'src/Build.hs')
| -rw-r--r-- | src/Build.hs | 420 |
1 files changed, 0 insertions, 420 deletions
diff --git a/src/Build.hs b/src/Build.hs deleted file mode 100644 index ffbf264..0000000 --- a/src/Build.hs +++ /dev/null @@ -1,420 +0,0 @@ -{-# 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 </> (map toLower 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" $ unWindowsPath absoluteBuildDirectory - setEnv - "INCLUDE_DIRS" - (intercalate " " (map unWindowsPath absoluteLibraryDirectories)) - let archiveFile = - (unWindowsPath 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 - -unWindowsPath :: String -> String -unWindowsPath = changeSeparators . removeDriveLetter - -removeDriveLetter :: String -> String -removeDriveLetter path | ':' `elem` path = (tail . dropWhile (/= ':')) path - | otherwise = path - -changeSeparators :: String -> String -changeSeparators = replace "\\" "/" |