Add a custom make script

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)