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
|
#!/usr/bin/env runhaskell
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# OPTIONS_GHC -Wall #-}
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
Watch -> 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 "ok, waiting..."
Make -> bild app >> say "ok"
bild :: App -> IO ()
bild app = do
say $ "make: " ++ name app
apex app `catch` nop
aero app `catch` nop
say :: String -> IO ()
say = putStrLn
nop :: SomeException -> IO ()
nop _ = pure ()
data Action = Make | Watch
parseArgs :: [String] -> (App, Action)
parseArgs [] = errorWithoutStackTrace "usage: chip/make <app> [watch]"
parseArgs (name:act:_) =
( App (lowercase name) (capitalize name)
, case lowercase act of
"watch" -> Watch
_ -> 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"
apex :: App -> IO ()
apex App {..} = callCommand $ intercalate " "
[ "ghc"
, ghcopts
, "-iapex -ilore"
, "-main-is", entrypoint
, "--make", "apex/" ++ entrypoint ++ ".hs"
, "-o bild/" ++ name
]
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)
|
