diff --git a/app/Main.hs b/app/Main.hs --- a/app/Main.hs +++ b/app/Main.hs @@ -1,31 +1,11 @@ module Main where -import New -import Build -import Data.List (intercalate) -import Data.Char import System.Environment (getArgs) - -newtype Command = Command { unCommand :: String } -newtype CommandArgs = CommandArgs { unCommandArgs :: [String] } - -runPlugin :: Command -> CommandArgs -> IO () -runPlugin c a = do - let command = unCommand c - args = unCommandArgs a - plugin = case toLower `fmap` command of - "new" -> new - p -> error $ "not support plugin: " ++ p - - putStrLn $ "Calling " ++ command ++ " with [" ++ intercalate " " args ++ "]." - run plugin args +import Desert main :: IO () main = do args <- getArgs case args of - [] -> build - [cmd] | cmd `elem` ["clean", "run", "test"] -> build - (command:otherargs) -> runPlugin (Command command) - (CommandArgs otherargs) - + (command:otherargs) -> openKeg (Command command) (CommandArgs otherargs) + _ -> putStrLn "usage: desert " diff --git a/desert.cabal b/desert.cabal --- a/desert.cabal +++ b/desert.cabal @@ -1,5 +1,5 @@ name: desert -version: 0.1.0.0 +version: 0.1.0.1 synopsis: a simple build tool for OCaml projects description: Please see README.md homepage: https://github.com/zjhmale/desert @@ -15,8 +15,13 @@ library hs-source-dirs: src - exposed-modules: Build - , New + exposed-modules: Desert + , Desert.Plugin + , Desert.New + , Desert.Build + , Desert.Test + , Desert.Run + , Desert.Clean build-depends: base >= 4.7 && < 5 , bytestring >= 0.10.4.0 , directory >= 1.2.1.0 @@ -24,7 +29,7 @@ , process , transformers , http-conduit - , shake + , MissingH default-language: Haskell2010 ghc-options: -Wall diff --git a/src/Build.hs b/src/Build.hs deleted file mode 100644 --- a/src/Build.hs +++ /dev/null @@ -1,35 +0,0 @@ -module Build where - -import Development.Shake - -mlFiles :: [String] -mlFiles = ["//*.ml", "//*.mli", "//*.mll", "//*.mly"] - -build :: IO () -build = shakeArgs shakeOptions{shakeFiles="_build"} $ do - want ["_build/bin/main"] - want ["_build/bin/test"] - - phony "clean" $ do - putNormal "Cleaning files in _build" - removeFilesAfter "_build" ["//*"] - - phony "run" $ do - cmd "_build/bin/main" - - phony "test" $ do - cmd "_build/bin/test" - - "_build/bin/main" %> \_ -> do - cs <- getDirectoryFiles "" mlFiles - need cs - () <- cmd "ocamlbuild -use-ocamlfind main.native" - () <- cmd "mkdir -p _build/bin" - cmd "mv main.native _build/bin/main" - - "_build/bin/test" %> \_ -> do - cs <- getDirectoryFiles "" mlFiles - need cs - () <- cmd "ocamlbuild -use-ocamlfind -package oUnit test.native" - () <- cmd "mkdir -p _build/bin" - cmd "mv test.native _build/bin/test" diff --git a/src/Desert.hs b/src/Desert.hs new file mode 100644 --- /dev/null +++ b/src/Desert.hs @@ -0,0 +1,26 @@ +module Desert where + +import Data.Char + +import qualified Desert.New as New +import qualified Desert.Build as Build +import qualified Desert.Test as Test +import qualified Desert.Run as Run +import qualified Desert.Clean as Clean +import Desert.Plugin + +newtype Command = Command { unCommand :: String } +newtype CommandArgs = CommandArgs { unCommandArgs :: [String] } + +openKeg :: Command -> CommandArgs -> IO () +openKeg c a = do + let command = unCommand c + args = unCommandArgs a + plugin = case toLower `fmap` command of + "new" -> New.plugin + "build" -> Build.plugin + "test" -> Test.plugin + "run" -> Run.plugin + "clean" -> Clean.plugin + subc -> error $ "not support subcmd " ++ subc ++ " yet" + run plugin args diff --git a/src/Desert/Build.hs b/src/Desert/Build.hs new file mode 100644 --- /dev/null +++ b/src/Desert/Build.hs @@ -0,0 +1,11 @@ +module Desert.Build where + +import Desert.Plugin (DesertPlugin (..)) + +import System.Process + +plugin :: DesertPlugin +plugin = DesertPlugin $ + \_ -> do + mapM_ (\n -> rawSystem "ocamlbuild" ["-use-ocamlfind", "-package", "oUnit", "-package", "core", n ++ ".native"]) ["main", "test"] + return () diff --git a/src/Desert/Clean.hs b/src/Desert/Clean.hs new file mode 100644 --- /dev/null +++ b/src/Desert/Clean.hs @@ -0,0 +1,15 @@ +module Desert.Clean where + +import Desert.Plugin (DesertPlugin (..)) + +import System.Directory +import Data.String.Utils + +plugin :: DesertPlugin +plugin = DesertPlugin $ + \_ -> do + files <- getDirectoryContents "." + let compiledFiles = filter (endswith ".o") files + mapM_ removeFile compiledFiles + mapM_ removeFile ["main.native", "test.native"] + removeDirectoryRecursive "_build" diff --git a/src/Desert/New.hs b/src/Desert/New.hs new file mode 100644 --- /dev/null +++ b/src/Desert/New.hs @@ -0,0 +1,81 @@ +module Desert.New where + +import Desert.Plugin (DesertPlugin (..)) + +import qualified Data.ByteString.Lazy as L +import Data.List (intercalate) +import Network.HTTP.Conduit (simpleHttp) +import System.Directory +import System.FilePath +import System.Process + +plugin :: DesertPlugin +plugin = DesertPlugin $ \args -> do + let packageName = head args + + putStrLn $ "Creating new project named " ++ packageName + + alreadyExists <- doesDirectoryExist packageName + if (not alreadyExists) then createDirectory packageName else return () + + setCurrentDirectory packageName + + let sourceDir = "src" + testDir = "test" + mainFilePath = sourceDir "main.ml" + libHeaderFilePath = sourceDir "lib.mli" + libFilePath = sourceDir "lib.ml" + testFilePath = testDir "test.ml" + readmeFilePath = "README.md" --File path is filename in current dir + tagFilePath = "_tags" + + createDirectoryIfMissing True sourceDir + createDirectoryIfMissing True testDir + + writeFile mainFilePath $ intercalate "\n" + ["open Lib" + ,"" + ,"let _ = Printf.printf \"hello, we get: %s\\n\" (str_of_t (succ (succ one_t)));" + ] + + writeFile libHeaderFilePath $ intercalate "\n" + ["type t" + ,"" + ,"val one_t : t" + ,"val succ : t -> t" + ,"val str_of_t : t -> string" + ] + + writeFile libFilePath $ intercalate "\n" + ["type t = int" + ,"" + ,"let one_t = 1" + ,"let succ i = i+1" + ,"let str_of_t = string_of_int" + ] + + writeFile testFilePath $ intercalate "\n" + ["open OUnit" + ,"open Lib" + ,"" + ,"let suite = \"OUnit tests...\" >::: [\"Fix me\" >:: (fun () -> assert_equal \"1\" (str_of_t (succ (succ one_t))))]" + ,"" + ,"let _ = run_test_tt_main suite" + ] + + writeFile tagFilePath $ intercalate "\n" + [": include" + ,": package(core)" + ,": include" + ,": package(oUnit)" + ,"true:thread" + ] + + writeFile readmeFilePath $ intercalate "\n" + ["#" ++ packageName ++ "!"] + + _ <- rawSystem "git" ["init"] + + simpleHttp "https://raw.githubusercontent.com/github/gitignore/master/OCaml.gitignore" >>= L.writeFile ".gitignore" + + return () diff --git a/src/Desert/Plugin.hs b/src/Desert/Plugin.hs new file mode 100644 --- /dev/null +++ b/src/Desert/Plugin.hs @@ -0,0 +1,3 @@ +module Desert.Plugin where + +data DesertPlugin = DesertPlugin { run :: [String] -> IO () } diff --git a/src/Desert/Run.hs b/src/Desert/Run.hs new file mode 100644 --- /dev/null +++ b/src/Desert/Run.hs @@ -0,0 +1,11 @@ +module Desert.Run where + +import Desert.Plugin (DesertPlugin (..)) + +import System.Process + +plugin :: DesertPlugin +plugin = DesertPlugin $ + \args -> do + _ <- rawSystem "./main.native" args + return () diff --git a/src/Desert/Test.hs b/src/Desert/Test.hs new file mode 100644 --- /dev/null +++ b/src/Desert/Test.hs @@ -0,0 +1,11 @@ +module Desert.Test where + +import Desert.Plugin (DesertPlugin (..)) + +import System.Process + +plugin :: DesertPlugin +plugin = DesertPlugin $ + \_ -> do + _ <- rawSystem "./test.native" [] + return () diff --git a/src/New.hs b/src/New.hs deleted file mode 100644 --- a/src/New.hs +++ /dev/null @@ -1,79 +0,0 @@ -module New where - -import qualified Data.ByteString.Lazy as L -import Data.List (intercalate) -import Network.HTTP.Conduit (simpleHttp) -import System.Directory -import System.FilePath -import System.Process - -data DesertPlugin = DesertPlugin { run :: [String] -> IO () } - -new :: DesertPlugin -new = DesertPlugin $ \args -> do - let packageName = head args - - putStrLn $ "Creating new project named " ++ packageName - - alreadyExists <- doesDirectoryExist packageName - if (not alreadyExists) then createDirectory packageName else return () - - setCurrentDirectory packageName - - let sourceDir = "src" - testDir = "test" - mainFilePath = sourceDir "main.ml" - libHeaderFilePath = sourceDir "lib.mli" - libFilePath = sourceDir "lib.ml" - testFilePath = testDir "test.ml" - readmeFilePath = "README.md" --File path is filename in current dir - tagFilePath = "_tags" - - createDirectoryIfMissing True sourceDir - createDirectoryIfMissing True testDir - - writeFile mainFilePath $ intercalate "\n" - ["open Lib", - "", - "let _ = Printf.printf \"hello, we get: %s\\n\" (str_of_t (succ (succ one_t)));" - ] - - writeFile libHeaderFilePath $ intercalate "\n" - ["type t", - "", - "val one_t : t", - "val succ : t -> t", - "val str_of_t : t -> string" - ] - - writeFile libFilePath $ intercalate "\n" - ["type t = int", - "", - "let one_t = 1", - "let succ i = i+1", - "let str_of_t = string_of_int" - ] - - writeFile testFilePath $ intercalate "\n" - ["open OUnit", - "open Lib", - "", - "let suite = \"OUnit tests...\" >::: [\"Fix me\" >:: (fun () -> assert_equal \"1\" (str_of_t (succ (succ one_t))))]", - "", - "let _ = run_test_tt_main suite" - ] - - writeFile tagFilePath $ intercalate "\n" - [": include", - ": include", - ": package(oUnit)" - ] - - writeFile readmeFilePath $ intercalate "\n" - ["#" ++ packageName ++ "!"] - - _ <- rawSystem "git" ["init"] - - simpleHttp "https://raw.githubusercontent.com/github/gitignore/master/OCaml.gitignore" >>= L.writeFile ".gitignore" - - return ()