1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
|
module Main where
import Build ( buildLibrary
, buildPrograms
)
import Development.Shake ( FilePattern
, (<//>)
, getDirectoryFilesIO
)
import Development.Shake.FilePath ( (</>) )
import Options.Applicative ( Parser
, (<**>)
, command
, execParser
, fullDesc
, info
, header
, helper
, progDesc
, subparser
)
newtype Arguments = Arguments { command' :: Command }
data Command = Run | Test | Build
main :: IO ()
main = do
args <- getArguments
app args
app :: Arguments -> IO ()
app args = case command' args of
Run -> putStrLn "Run"
Test -> putStrLn "Test"
Build -> build
build :: IO ()
build = do
putStrLn "Building"
buildLibrary "src"
[".f90", ".f", ".F", ".F90", ".f95", ".f03"]
("build" </> "library")
"gfortran"
["-g", "-Wall", "-Wextra", "-Werror", "-pedantic"]
"library"
[]
buildPrograms "app"
["build" </> "library"]
[".f90", ".f", ".F", ".F90", ".f95", ".f03"]
("build" </> "app")
"gfortran"
["-g", "-Wall", "-Wextra", "-Werror", "-pedantic"]
getArguments :: IO Arguments
getArguments = execParser
(info
(arguments <**> helper)
(fullDesc <> progDesc "Work with Fortran projects" <> header
"fpm - A Fortran package manager and build system"
)
)
arguments :: Parser Arguments
arguments = subparser
( command "run" (info runArguments (progDesc "Run the executable"))
<> command "test" (info testArguments (progDesc "Run the tests"))
<> command "build" (info buildArguments (progDesc "Build the executable"))
)
runArguments :: Parser Arguments
runArguments = pure $ Arguments Run
testArguments :: Parser Arguments
testArguments = pure $ Arguments Test
buildArguments :: Parser Arguments
buildArguments = pure $ Arguments Build
getDirectoriesFiles :: [FilePath] -> [FilePattern] -> IO [FilePath]
getDirectoriesFiles dirs exts = getDirectoryFilesIO "" newPatterns
where
newPatterns = concatMap appendExts dirs
appendExts dir = map ((dir <//> "*") ++) exts
|
