nemesis-titan 2013.7.14 → 2014.5.19
raw patch · 2 files changed
+58/−57 lines, 2 filesdep +air-thdep ~airPVP ok
version bump matches the API change (PVP)
Dependencies added: air-th
Dependency ranges changed: air
API changes (from Hackage documentation)
Files
- nemesis-titan.cabal +6/−5
- src/System/Nemesis/Titan.hs +52/−52
nemesis-titan.cabal view
@@ -1,8 +1,8 @@ Name: nemesis-titan-Version: 2013.7.14+Version: 2014.5.19 Build-type: Simple Synopsis: A collection of Nemesis tasks to bootstrap a Haskell project with a focus on continuous integration-Description: +Description: License: BSD3 License-file: LICENSE@@ -24,7 +24,8 @@ ghc-options: -Wall build-depends: base >= 4 && < 100 , nemesis- , air+ , air >= 2014.5.19+ , air-th , uuid , random , directory@@ -32,7 +33,7 @@ , filepath , HStringTemplate , hspec- + hs-source-dirs: src/- exposed-modules: + exposed-modules: System.Nemesis.Titan
src/System/Nemesis/Titan.hs view
@@ -3,14 +3,14 @@ module System.Nemesis.Titan where- + import System.Nemesis.Env import System.Nemesis (Unit) import Air.Env hiding (mod) import Prelude () import Air.TH-import Air.Data.Record.SimpleLabel (get, set, mod)+import Air.Data.Record.SimpleLabel (get, set, mod, label) import qualified Data.ByteString.Char8 as B import qualified Data.UUID as UUID@@ -61,23 +61,23 @@ event_time = Time.now update_time = Time.now update_interval = 0.1- + watch(%r{^src/.+hs\$}) do |m| puts "Changed #{m[0]}" event_time = Time.now end # compile at most once for every \$update_interval seconds- Thread.new do + Thread.new do while true sleep update_interval- if event_time > update_time + if event_time > update_time update_time = Time.now system("runghc Nemesis $project_name$/compile-and-kill") end end end- + end |] @@ -103,16 +103,16 @@ titan_spec = hspec - do describe "Titan" - do it "should run spec" True- + it "should use templates" - do let text = render - setAttribute "project_name" "Main" angel_template- + -- puts text- + text `shouldSatisfy` (null > not)- + data Config = Config { pid_name :: String@@ -149,30 +149,30 @@ titan_with_config :: Config -> Unit titan_with_config config = do namespace (config.project_name) - do- - let ++ let _project_name = config.project_name config_project_name_directory = config.config_directory / _project_name angel_path = config_project_name_directory / "Angel.conf" angel_live_path = config_project_name_directory / "AngelLive.conf" guard_path = config_project_name_directory / "Guardfile"- + pid_directory = config.bin_directory / _project_name pid_path = pid_directory / config.pid_name haskell_source_path = config.haskell_source_directory / config.file_name- + desc "Initialize a Titan node" task "init" - io - do createDirectoryIfMissing True config_project_name_directory createDirectoryIfMissing True (config.haskell_source_directory)- - let ++ let angel_file_content = render - setAttribute "project_name" _project_name angel_template angel_live_file_content = render - setAttribute "project_name" _project_name angel_live_template guard_file_content = render - setAttribute "project_name" _project_name guard_template haskell_file_content = render - setAttribute "project_name" _project_name haskell_template- + let { write_if_not_exist file_path str = do file_exist <- doesFileExist file_path@@ -183,13 +183,13 @@ puts - file_path + " already exists!" return () }- - write_if_not_exist angel_path angel_file_content - write_if_not_exist angel_live_path angel_live_file_content - write_if_not_exist guard_path guard_file_content ++ write_if_not_exist angel_path angel_file_content+ write_if_not_exist angel_live_path angel_live_file_content+ write_if_not_exist guard_path guard_file_content write_if_not_exist haskell_source_path haskell_file_content- - ++ let { get_and_create_if_missing_upid = do createDirectoryIfMissing True pid_directory @@ -199,14 +199,14 @@ if pid_exist then do uuid <- B.readFile pid_path ^ B.unpack- return 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@@ -215,11 +215,11 @@ desc "Start the Titan managed process" task "titan:uuid compile" - do sh - "angel " + angel_path- + desc "Start the Titan managed process for deployment (no auto recompile)" task "titan-live:uuid compile" - do sh - "angel " + angel_live_path- + desc "Create a uuid for this process if not already exist" task "uuid" - do io - void - get_and_create_if_missing_upid@@ -228,14 +228,14 @@ task "compile" - do bin <- get_bin let { cmd =- printf "ghc --make -i%s %s %s %s -o %s" + printf "ghc --make -i%s %s %s %s -o %s" (config.haskell_source_directory) (config.ghc_default_arg_string) (config.ghc_arg_string) haskell_source_path bin }- + -- puts cmd sh cmd @@ -248,22 +248,22 @@ task "kill" - do upid <- get_and_create_if_missing_upid sh - "killall -SIGTERM " + upid + "; true"- + desc "Compile and Kill" task "compile-and-kill: compile kill" - return ()- + desc "Start the Guard process" task "guard" - do- sh - printf "guard %s %s -G %s" + sh - printf "guard %s %s -G %s" (config.guard_default_arg_string) (config.guard_arg_string) guard_path- - ++ -- shortcut let shortcut_task_name = printf "t:%s/titan" (config.project_name) shortcut_description = printf "Short task name for %s/titan" (config.project_name)- + desc shortcut_description task shortcut_task_name - return () @@ -289,7 +289,7 @@ mkLabel ''MacAppArgs default_mac_app_config :: Config-default_mac_app_config = +default_mac_app_config = def.set __ghc_arg_string "-lobjc" instance Default MacAppArgs where@@ -306,15 +306,15 @@ titan_mac_app :: MacAppArgs -> Unit titan_mac_app args = do- let + let _target_name = args.target_name _dashed_target_name = _target_name.map (\x -> if x.is ' ' then '-' else x) _project_name = args.mac_app_project_name.fromMaybe _dashed_target_name _file_name = args.mac_app_file_name.fromMaybe (args.mac_app_config.file_name)- + _new_ghc_arg_string = args.frameworks.map ("-framework" +) .join " "- - _config = ++ _config = args.mac_app_config .set __file_name _file_name .set __project_name _project_name@@ -322,18 +322,18 @@ titan_with_config _config - let + let _scheme_name = args.scheme_name.fromMaybe _target_name _derived_data_path = args.derived_data_path- - ++ namespace _project_name - do- + let config = _config haskell_source_path = config.haskell_source_directory / config.file_name bin = config.bin_directory / _project_name / "dummy_binary"- + task ("clean") - do sh - printf "rm -rf %s" _derived_data_path sh - printf "mkdir %s" _derived_data_path@@ -351,7 +351,7 @@ } sh cmd- + let xcode_build_cmd = printf "cd .. && xcodebuild -scheme '%s' > /dev/null" _scheme_name sh xcode_build_cmd @@ -361,15 +361,15 @@ task ("run") - do sh - printf "cd %s; find . -name '%s' -exec '{}' \\;" _derived_data_path _target_name- - ++ -- shortcut let shortcut_task_name = printf "t:%s/kill %s/titan" _project_name _project_name shortcut_description = printf "%s/kill then %s/titan" _project_name _project_name desc shortcut_description task shortcut_task_name - return ()- + -- Helpers safe_spec :: IO () -> IO ExitCode safe_spec spec = E.handle (\e -> return (e :: ExitCode)) - do@@ -378,15 +378,15 @@ 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