#!/usr/bin/env runhaskell

-- TODO: rewrite this in using shake
-- https://hackage.haskell.org/package/shake-0.17.7/docs/Development-Shake.html

{-# 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)