summaryrefslogtreecommitdiff
path: root/chip/make
diff options
context:
space:
mode:
authorBen Sima <ben@bsima.me>2019-11-02 15:54:20 -0700
committerBen Sima <ben@bsima.me>2019-11-02 17:13:04 -0700
commited4e214d481f67f796014aa80731b6d273618b6c (patch)
treef44cd4b80de8b624f38f7637f4615b79517ee993 /chip/make
parent9d114cfc773171b0a95bd4d2c39f1bb0eb783c8d (diff)
add common scripts, remove old scripts, update readme
Diffstat (limited to 'chip/make')
-rwxr-xr-xchip/make138
1 files changed, 0 insertions, 138 deletions
diff --git a/chip/make b/chip/make
deleted file mode 100755
index da5fe97..0000000
--- a/chip/make
+++ /dev/null
@@ -1,138 +0,0 @@
-#!/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
- Tidy -> do
- callCommand "rm -rf bild/*"
- say "made: tidy"
-
-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 | Tidy
-
-parseArgs :: [String] -> (App, Action)
-parseArgs [] = errorWithoutStackTrace "usage: chip/make [make|rise|tidy] <app>"
-parseArgs (act:name:_) =
- ( App (lowercase name) (capitalize name)
- , case lowercase act of
- "rise" -> Rise
- "tidy" -> Tidy
- _ -> Make
- )
-parseArgs (name:_) = case name of
- "tidy" -> (App (lowercase "") (capitalize ""), Tidy)
- _ -> (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
- }
-
--- | common build options.
-ghcopts :: String
-ghcopts = "-odir bild/o -hidir bild/hi -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)