summaryrefslogtreecommitdiff
path: root/chip
diff options
context:
space:
mode:
authorBen Sima <ben@bsima.me>2019-03-26 12:49:15 -0700
committerBen Sima <ben@bsima.me>2019-03-26 12:52:53 -0700
commit1c51ae337b5a88f17e85ec13be78f6c05802dfc8 (patch)
treee1122d61e3a308843ee3ad0aa373a804e967e18b /chip
parentf50cecf2cb77cc073cb86a6016468a09d1c49fb0 (diff)
Add a custom make script
Diffstat (limited to 'chip')
-rwxr-xr-xchip/make121
1 files changed, 121 insertions, 0 deletions
diff --git a/chip/make b/chip/make
new file mode 100755
index 0000000..6eabae0
--- /dev/null
+++ b/chip/make
@@ -0,0 +1,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", "apex/" ++ 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)