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
|
#!/usr/bin/env runhaskell
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# OPTIONS_GHC -Wall #-}
-- | chip/make
--
-- this is the main build script. it just calls out to `ghc --make` basically.
--
module Main where
import Control.Concurrent
import Control.Exception
import Control.Monad
import Data.ByteString.Char8 (pack)
import qualified Data.Char as Char
import Data.List
import System.Directory
import System.Environment
import System.FilePath
import System.INotify
import System.Process
data Notify = Notify
{ notify :: IO ()
, wait :: IO ()
}
-- | skip channel to model concurrency semantics. this ensures that we don't
-- execute more than one command at a time.
initNotify :: IO Notify
initNotify = do
mvar <- newMVar ()
pure $ Notify
(void $ tryPutMVar mvar ())
(takeMVar mvar)
main :: IO ()
main = do
(app, act) <- parseArgs <$> getArgs
case act of
Rise -> do
inotify <- initINotify
Notify {..} <- initNotify
dirs <- nub . concat <$> mapM getDirs ["aero", "apex", "lore"]
forM_ dirs $ \arg ->
void $ addWatch inotify [Modify] (pack arg) (const notify)
forever $ wait >> bild app >> say "waiting..."
Make -> bild app
bild :: App -> IO ()
bild app = do
say $ "make: " ++ name app
apex app `catch` nop
aero app `catch` nop
say $ "made: " ++ name app
say :: String -> IO ()
say = putStrLn
nop :: SomeException -> IO ()
nop _ = pure ()
data Action = Make | Rise
parseArgs :: [String] -> (App, Action)
parseArgs [] = errorWithoutStackTrace "usage: chip/make [make|rise] <app>"
parseArgs (act:name:_) =
( App (lowercase name) (capitalize name)
, case lowercase act of
"rise" -> Rise
_ -> Make
)
parseArgs (name:_) = (App (lowercase name) (capitalize name), Make)
capitalize, lowercase :: String -> String
capitalize (α:ω) = Char.toUpper α : map Char.toLower ω
capitalize [] = []
lowercase (α:ω) = Char.toLower α : map Char.toLower ω
lowercase [] = []
data App = App
{ name :: String
, entrypoint :: String
}
ghcopts :: String
ghcopts = "-odir bild/ -hidir bild/ -Wall"
-- | compile with ghc.
apex :: App -> IO ()
apex App {..} = callCommand $ intercalate " "
[ "ghc"
, ghcopts
, "-iapex -ilore"
, "-main-is", entrypoint
, "--make", "apex/" ++ entrypoint ++ ".hs"
, "-o bild/" ++ name
]
-- | compile with ghcjs.
aero :: App -> IO ()
aero App {..} = callCommand $ intercalate " "
[ "ghcjs"
, ghcopts
, "-iaero -ilore"
, "-main-is", entrypoint
, "--make", "aero/" ++ entrypoint ++ ".hs"
, "-o bild/" ++ name
]
getDirs :: FilePath -> IO [FilePath]
getDirs path = do
isDir <- doesDirectoryExist path
if isDir
then do
dirs <- listDirectory path
if null dirs
then pure [path]
else concat <$> do
mapM getDirs $ (path </>) <$> dirs
else pure [prune path]
prune :: String -> String
prune = reverse . dropWhile (/= '/') . reverse
secs :: Int -> Int
secs = (* 1000000)
|
