{-# LANGUAGE QuasiQuotes #-} module System.Nemesis.Titan where import System.Nemesis.Env import System.Nemesis (Unit) import Air.Env import Prelude () import qualified Data.ByteString.Char8 as B import qualified Data.UUID as UUID import System.Directory import System.Random import System.Environment (getArgs) import System.FilePath import Air.TH (here) 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 Air.Extra (with_spec, halt) import System.Nemesis.Jinjing.Angel 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) get_label_file_name :: IO (Maybe (String, String)) get_label_file_name = do xs <- io getArgs case xs of (_:file_name:[]) -> let label = file_name.takeBaseName in return - Just (label, file_name) (_:label:file_name:[]) -> return - Just (label, file_name) _ -> return Nothing 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