module Rest.Gen where import Data.Char import Data.Label import Data.Foldable import Data.Maybe import System.Directory import System.Exit import System.Process import Rest.Api (withVersion, Api, Some1 (..)) import Rest.Gen.Config import Rest.Gen.Docs.Generate (writeDocs, DocsContext (DocsContext)) import Rest.Gen.JavaScript.Generate (mkJsApi) import Rest.Gen.Haskell.Generate (mkHsApi, HaskellContext (HaskellContext)) import Rest.Gen.Ruby.Generate (mkRbApi) import Rest.Gen.Utils generate :: Config -> String -> Api m -> [String] -> [String] -> [(String, String)] -> IO () generate config name api sources imports rewrites = withVersion (get apiVersion config) api (putStrLn "Could not find api version" >> exitFailure) $ \ver (Some1 r) -> case get action config of Just (MakeDocs root) -> do loc <- getTargetDir config "./docs" setupTargetDir config loc let context = DocsContext root ver (fromMaybe "./templates" (getSourceLocation config)) writeDocs context r loc exitSuccess Just MakeJS -> mkJsApi (moduleName ++ "Api") (get apiPrivate config) ver r >>= toTarget config Just MakeRb -> mkRbApi (moduleName ++ "Api") (get apiPrivate config) ver r >>= toTarget config Just MakeHS -> do loc <- getTargetDir config "./client" setupTargetDir config loc let context = HaskellContext ver loc (packageName ++ "-client") (get apiPrivate config) sources imports rewrites [moduleName, "Client"] mkHsApi context r exitSuccess Nothing -> return () where packageName = map toLower name moduleName = upFirst packageName getTargetDir :: Config -> String -> IO String getTargetDir config str = case get target config of Stream -> putStrLn ("Cannot generate documentation to stdOut, generating to " ++ str) >> return str Default -> putStrLn ("Generating to " ++ str) >> return str Location d -> putStrLn ("Generating to " ++ d) >> return d setupTargetDir :: Config -> String -> IO () setupTargetDir config t = do createDirectoryIfMissing True t forM_ (getSourceLocation config) $ \s -> system $ "cp -rf " ++ s ++ " " ++ t toTarget :: Config -> String -> IO () toTarget config code = do let outf = case get target config of Stream -> putStrLn Default -> putStrLn Location l -> writeFile l outf code exitSuccess getSourceLocation :: Config -> Maybe String getSourceLocation config = case get source config of Location s -> Just s _ -> Nothing