{-# LANGUAGE QuasiQuotes #-}

module System.Nemesis.Titan where
  
import System.Nemesis.Env
import System.Nemesis (Unit)

import Air.Env
import Prelude ()
import Air.TH (here)

import qualified Data.ByteString.Char8 as B
import qualified Data.UUID as UUID
import System.Directory
import System.Random
import System.FilePath
import System.Exit (ExitCode(..))
import qualified Control.Exception as E
import Control.Monad (forever)

import Test.Hspec
import Text.StringTemplate


angel_template :: StringTemplate String
angel_template = newSTMP - [here|
server {
    exec = "runghc Nemesis $label$/run"
    stdout = "/dev/stdout"
    stderr = "/dev/stderr"
    delay = 0
}

code-reload {
    exec = "runghc Nemesis $label$/guard"
    stdout = "/dev/stdout"
    stderr = "/dev/stderr"
    delay = 0
}

|]


guard_template :: StringTemplate String
guard_template = newSTMP - [here|
guard :shell do
  watch(%r{^src/.+hs\$}) do |m|
    puts "Changed #{m[0]}"
    `runghc Nemesis $label$/compile && runghc Nemesis $label$/kill`
  end
end

|]


haskell_template :: StringTemplate String
haskell_template = newSTMP - [here|
module Main where

import System.Nemesis.Titan
import Test.Hspec

spec :: IO ()
spec = hspec \$ do
  describe "$label$" \$ do
    it "should run spec" True

main = do
  with_spec spec halt

|]

titan_spec :: IO ()
titan_spec = hspec - do
  describe "Titan" - do
    it "should run spec" True
    
    it "should use templates" - do
      let text = render - setAttribute "label" "Main" angel_template
      
      -- puts text
      
      text `shouldSatisfy` (null > not)
      

titan :: String -> Unit
titan file_name = do
  let label = file_name.takeBaseName
  titan_with_label_file_name label file_name

titan_with_label_file_name :: String -> String -> Unit
titan_with_label_file_name label file_name = titan_with_label_file_name_custom_task label file_name (return ())


titan_with_label_file_name_custom_task :: String -> String -> Unit -> Unit
titan_with_label_file_name_custom_task label file_name custom_tasks = do
  namespace label - do
    
    let  
      pid_name = "uuid.txt"
      bin_directory = ".bin"
      config_name = "config"
      config_directory = config_name / label
      angel_path = config_directory / "Angel.conf"
      guard_path = config_directory / "Guardfile"
      
      pid_directory = bin_directory / label
      pid_path = pid_directory / pid_name

    desc "Initialize a Titan node"
    task "init" - io - do
      let
        haskell_source_directory = "src"
        haskell_path = haskell_source_directory / file_name
      

      createDirectoryIfMissing True config_directory
      createDirectoryIfMissing True haskell_source_directory
      
      let 
        angel_file_content = render - setAttribute "label" label angel_template
        guard_file_content = render - setAttribute "label" label guard_template
        haskell_file_content = render - setAttribute "label" label haskell_template
      
      let {
        write_if_not_exist file_path str = do
          file_exist <- doesFileExist file_path
          if not - file_exist
            then
              B.writeFile file_path - B.pack str
            else do
              puts - file_path + " already exists!"
              return ()
      }
      write_if_not_exist angel_path angel_file_content 
      write_if_not_exist guard_path guard_file_content 
      write_if_not_exist haskell_path haskell_file_content
    
                      
    let { get_and_create_if_missing_upid = do
      createDirectoryIfMissing True pid_directory

      pid_exist <- doesFileExist pid_path


      if pid_exist
        then do
          uuid <- B.readFile pid_path ^ B.unpack
          puts - "UPID: " + uuid
          return uuid      
        else do
          uuid <- randomIO ^ UUID.toString
          puts - "Created UPID: " + uuid
          B.writeFile pid_path - uuid.B.pack
          return - uuid
      }
          
    let { get_bin = do
      uuid <- get_and_create_if_missing_upid
      return - pid_directory / uuid
    }

    desc "Start the Titan managed process"
    task "titan:uuid compile" - do
      sh - "angel " + angel_path

  
    desc "Create a uuid for this process if not already exist"
    task "uuid" - do
      io - void - get_and_create_if_missing_upid

    desc "Compile the binary"
    task "compile" - do
      bin <- get_bin
      sh - "ghc --make -isrc -threaded src/" + file_name + " -o " + bin

    desc "Start the process"
    task "run" - do
      bin <- get_bin
      sh - bin

    desc "Kill the process"
    task "kill" - do
      upid <- get_and_create_if_missing_upid
      sh - "killall " + upid + "; true"
  
    desc "Start the Guard proceses"
    task "guard" - do
      sh - "guard --no-bundler-warning -G " + guard_path
  
    custom_tasks


-- Helpers
safe_spec :: IO () -> IO ExitCode
safe_spec spec = E.handle (\e -> return (e :: ExitCode)) - do
  spec
  return ExitSuccess

halt :: IO ()
halt = forever - sleep (1 :: Double)
  
with_spec :: IO () -> IO b -> IO ()
with_spec spec process = do
  exit_code <- safe_spec spec
  
  case exit_code of
    ExitSuccess -> do
      fork - process
    _ ->
      return ()
  
  halt