diff options
Diffstat (limited to 'chip/make')
-rwxr-xr-x | chip/make | 138 |
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) |