diff --git a/nemesis-titan.cabal b/nemesis-titan.cabal --- a/nemesis-titan.cabal +++ b/nemesis-titan.cabal @@ -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 diff --git a/src/System/Nemesis/Titan.hs b/src/System/Nemesis/Titan.hs --- a/src/System/Nemesis/Titan.hs +++ b/src/System/Nemesis/Titan.hs @@ -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