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
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
|
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE NoImplicitPrelude #-}
-- | A general purpose build tool.
--
-- - with a nix build, results are linked in _bild/nix/<target>
-- - for a dev build, results are stored in _bild/dev/<target>
module Biz.Bild where
import Alpha hiding ((<.>), sym)
import qualified Data.Char as Char
import qualified Data.List as List
import qualified Data.Text as Text
import qualified System.Directory as Dir
import qualified System.Environment as Env
import qualified System.Exit as Exit
import System.FilePath ((<.>), (</>))
import qualified System.Process as Process
import Text.Regex.Applicative
import qualified Prelude
main :: IO ()
main = Env.getArgs /> head >>= \case
Nothing -> Exit.die "usage: bild <target>"
Just target -> analyze target >>= build
type Namespace = String
type Dep = String
type Exe = String
data Compiler = Ghc | Ghcjs | Nix
deriving (Show)
data Target
= Target
{ -- | Output executable name
exe :: Exe,
-- | Fully qualified namespace partitioned by '.'
namespace :: Namespace,
-- | Absolute path to file
path :: FilePath,
-- | Parsed/detected dependencies
deps :: [Dep],
-- | Which compiler should we use?
compiler :: Compiler
}
deriving (Show)
analyze :: String -> IO Target
analyze s = do
root <- Env.getEnv "BIZ_ROOT"
cwd <- Dir.getCurrentDirectory
-- this is a hack to support multiple file types. Ideally we would just detect
-- which file extensions exist
let path = cwd </> reps "." "/" s |> reps "/hs" ".hs" |> reps "/nix" ".nix"
content <- lines </ Prelude.readFile path
let exe = content /> match metaExe |> catMaybes |> head |> require "exe"
return
Target
{ namespace =
require "namespace"
<| path
|> reps root ""
|> reps ".hs" ""
|> reps ".nix" ""
|> reps "/" "."
|> List.stripPrefix "."
>>= match metaNamespace,
deps = content /> match metaDep |> catMaybes,
compiler =
if ".hs" `List.isSuffixOf` path
then if ".js" `List.isSuffixOf` exe then Ghcjs else Ghc
else Nix,
..
}
build :: Target -> IO ()
build Target {..} = do
root <- Env.getEnv "BIZ_ROOT"
case compiler of
Ghc -> do
putText <| "bild: ghc: " <> Text.pack namespace
let out = root </> "_bild/dev/bin"
Dir.createDirectoryIfMissing True out
Process.callProcess
"ghc"
[ "-Werror",
"-i" <> root,
"-odir",
root </> "_bild/int",
"-hidir",
root </> "_bild/int",
"--make",
path,
"-main-is",
namespace,
"-o",
out </> exe
]
Ghcjs -> do
putText <| "bild: ghcjs: " <> Text.pack namespace
let out = root </> "_bild/dev/static"
Dir.createDirectoryIfMissing True out
Process.callProcess
"ghcjs"
[ "-Werror",
"-i" <> root,
"-odir",
root </> "_bild/int",
"-hidir",
root </> "_bild/int",
"--make",
path,
"-main-is",
namespace,
"-o",
out </> exe
]
Nix -> do
putText <| "bild: nix: " <> Text.pack namespace
cwd <- Dir.getCurrentDirectory
let qualifiedTarget = reps root "" cwd <> namespace
Process.callProcess
"nix-build"
[ "-o",
root </> "_bild/nix" </> qualifiedTarget,
root </> "default.nix",
"--attr",
qualifiedTarget
]
metaNamespace :: RE Char Namespace
metaNamespace = name <> many (sym '.') <> name
where
name = many (psym Char.isUpper) <> many (psym Char.isLower)
metaDep :: RE Char Dep
metaDep = string "-- : dep " *> many (psym Char.isAlpha)
metaExe :: RE Char Exe
metaExe = string "-- : exe " *> many (psym (/= ' '))
require :: Text -> Maybe a -> a
require s (Just x) = x
require s Nothing = panic <| s <> " not found"
-- | Replace 'a' in 's' with 'b'.
reps :: String -> String -> String -> String
reps a b s@(x : xs) =
if isPrefixOf a s
then-- then, write 'b' and replace jumping 'a' substring
b ++ reps a b (drop (length a) s)
else-- then, write 'x' char and try to replace tail string
x : reps a b xs
reps _ _ [] = []
|
