packages feed

trurl 0.4.0.1 → 0.4.1.0

raw patch · 6 files changed

+31/−47 lines, 6 files

Files

src/Main.hs view
@@ -11,31 +11,33 @@ help = do   putStrLn "trurl <command> [parameters]"   putStrLn "  update -- fetch the updates from repository"-  putStrLn "  new project <name> <project_template> -j [parameters_string] -- create project of specified type with specified name; optionally add JSON parameters, wrap it with \"\" or ''"   putStrLn "  new project <name> <project_template> [parameters] -- create project of specified type with specified name; optionally add parameters"-  putStrLn "  new file <name> <file_template> -j [parameters_string] -- create file from the template with specified JSON parameters, wrap it with \"\" or ''"+  putStrLn "  new project <name> <project_template> -j [parameters_string] -- create project of specified type with specified name; optionally add JSON parameters, wrap it with \"\" or ''"   putStrLn "  new file <name> <file_template> [parameters] -- create file from the template with specified string parameters"+  putStrLn "  new file <name> <file_template> -j [parameters_string] -- create file from the template with specified JSON parameters, wrap it with \"\" or ''"   putStrLn "  list -- print all available templates"   putStrLn "  help <template> -- print template info"   putStrLn "  help -- print this help"   putStrLn "  version -- print version"  printVersion :: IO ()-printVersion = putStrLn "0.4.0.x"+printVersion = putStrLn "0.4.1.x"  main :: IO () main = do   args <- getArgs   case args of     []                                      -> help+    ["--help"]                              -> help+    ["-h"]                                  -> help     ["help"]                                -> help     ["help", template]                      -> helpTemplate template     ["update"]                              -> updateFromRepository     ["new", "project", name, project]       -> createProject name project "{}"     ["new", "project", name, project, "-j", params] -> createProject name project params-    ("new project": name: project: params)          -> createProject name project $ simpleParamsToJson $ unwords params+    ["new", "project", name, project, params]       -> createProject name project $ simpleParamsToJson params     ["new", "file", name, template, "-j" ,params]   -> newTemplate name template params-    ("new file": name: template: params)    -> newTemplate name template $ simpleParamsToJson $ unwords params+    ["new", "file", name, template, params] -> newTemplate name template $ simpleParamsToJson params     ["list"]                                -> listTemplates     ["version"]                             -> printVersion     ["--version"]                           -> printVersion
src/Registry.hs view
@@ -8,7 +8,6 @@  data Registry = Registry { url :: String                          , templateName :: String-                         , metainfoName :: String                          }   deriving (Show, Generic)                 
src/SimpleParams.hs view
@@ -10,10 +10,10 @@ parseEmbedded :: String -> String parseEmbedded str =   case splitOn "#" str of-    [name, typ] ->-      if endswith "@" typ-        then "{\"name\":\"" ++ name ++ "\",\"type\":\"" ++ replace "@" "" typ ++ "\",\"last\":true}"-        else "{\"name\":\"" ++ name ++ "\",\"type\":\"" ++ typ ++ "\"}"+    [k, v] ->+      if endswith "@" v+        then "{\"key\":\"" ++ k ++ "\",\"value\":\"" ++ replace "@" "" v ++ "\",\"last\":true}"+        else "{\"key\":\"" ++ k ++ "\",\"value\":\"" ++ v ++ "\"}"     _ -> ""  processPart :: String -> String@@ -26,11 +26,10 @@     symb = headDef ' ' str  simpleParamsToJson :: String -> String-simpleParamsToJson sparams =-    "{" ++  concatMap processPart (splitOnSpecialCharacters sparams) ++ "}"+simpleParamsToJson sparams = "{" ++  concatMap processPart (splitOnSpecialCharacters sparams) ++ "}"  splitOnSpecialCharacters :: String -> [String] splitOnSpecialCharacters = split $ dropBlanks $ oneOf specialCharacters -specialCharacters :: [Char]+specialCharacters :: String specialCharacters = ",:[]{} "
src/Trurl.hs view
@@ -13,7 +13,6 @@ import Data.String.Utils import System.FilePath.Find (find, always, fileName, extension, (==?), liftOp) import Safe-import Control.Monad  import qualified Data.Text as T import qualified Data.Text.Lazy.IO as TL@@ -53,14 +52,8 @@   removeFile filePath   return () -getFileName :: FilePath -> FilePath-getFileName template =-  if hasExtension template-    then template-    else template <.> "hs"- getFullFileName :: FilePath -> String -> FilePath-getFullFileName repoDir template = repoDir ++ getFileName template+getFullFileName repoDir template = repoDir ++ template  mkJsonContext :: Monad m => String -> MuContext m mkJsonContext =@@ -90,12 +83,16 @@    in dirName </> newFileName  downloadTemplate :: String -> Registry -> IO ()-downloadTemplate repoDir (Registry url tname mname) = do+downloadTemplate repoDir (Registry u tname) = do     let tFile = repoDir ++ tname+        mname = tname ++ ".metainfo"         mFile = repoDir ++ mname-        fullUrl = if endswith "/" url then url else url ++ "/"+        fullUrl = if endswith "/" u then u else u ++ "/"+     putStrLn $ "Fetching " ++ fullUrl ++ tname     simpleHttp (fullUrl ++ tname) >>= BL.writeFile tFile++    putStrLn $ "Fetching " ++ fullUrl ++ mname     simpleHttp (fullUrl ++ mname) >>= BL.writeFile mFile  -------------------------------------@@ -157,11 +154,11 @@ -- 4) Записать файл в ./ -- newTemplate :: String -> String -> String -> IO ()-newTemplate name templateName paramsStr = do+newTemplate name tName paramsStr = do   repoDir <- getLocalRepoDir-  let templPath = getFullFileName repoDir templateName+  let templPath = getFullFileName repoDir tName   generated <- hastacheFile defaultConfig templPath (mkFileContext name paramsStr)-  TL.writeFile (getFileName name) generated+  TL.writeFile name generated  -- Команда "list" -- 1) Найти все файлы с расширением '.metainfo'@@ -171,7 +168,7 @@ listTemplates = do   repoDir <- getLocalRepoDir   files <- getDirectoryContents repoDir-  let mpaths = filter (endswith ".metainfo") files+  let mpaths = filter (endswith ".metainfo") $ sort files   mapM_ (printFileHeader repoDir) mpaths  -- Команда "help <template>"@@ -183,4 +180,4 @@   repoDir <- getLocalRepoDir   templExists <- doesFileExist $ repoDir ++ template ++ ".metainfo"   if templExists then printFile repoDir $ template ++ ".metainfo"-  else printFile repoDir ((getFileName template) ++ ".metainfo")+  else printFile repoDir (template ++ ".tar.metainfo")
tests/Main.hs view
@@ -17,16 +17,7 @@  trurlTests :: TestTree trurlTests = testGroup "Trurl unit tests"-  [ testCase "getFullFileName" $-      assertEqual "Checking full template path" "a/b.hs" (T.getFullFileName "a/" "b")--  , testCase "getFileName" $-      assertEqual "Checking file name" "abc.hs" (T.getFileName "abc")--  , testCase "getFileName" $-      assertEqual "Checking file name" "abc.html" (T.getFileName "abc.html")--  , testCase "mkJsonContext empty" $ do+  [ testCase "mkJsonContext empty" $ do       generated <- hastacheStr defaultConfig "" (T.mkJsonContext "{\"a\":11}")       assertEqual "Checking generated text" "" generated @@ -62,19 +53,19 @@       assertEqual "Checking parseEmbedded" "" (S.parseEmbedded "abc")    , testCase "parseEmbedded with delimiter" $-      assertEqual "Checking parseEmbedded" "{\"name\":\"abc\",\"type\":\"efg\"}" (S.parseEmbedded "abc#efg")+      assertEqual "Checking parseEmbedded" "{\"key\":\"abc\",\"value\":\"efg\"}" (S.parseEmbedded "abc#efg")    , testCase "parseEmbedded with delimiter" $-      assertEqual "Checking parseEmbedded" "{\"name\":\"abc\",\"type\":\"efg\",\"last\":true}" (S.parseEmbedded "abc#efg@")+      assertEqual "Checking parseEmbedded" "{\"key\":\"abc\",\"value\":\"efg\",\"last\":true}" (S.parseEmbedded "abc#efg@")    , testCase "simpleParamsToJson" $       assertEqual "Checking simpleParamsToJson"-                  "{\"abc\":123,\"efg\":456,\"zxc\":[1,2,3],\"ttt\":[{\"name\":\"abc\",\"type\":\"efg\"},{\"name\":\"hck\",\"type\":\"qwe\"},{\"name\":\"zxc\",\"type\":\"vbn\",\"last\":true}]}"+                  "{\"abc\":123,\"efg\":456,\"zxc\":[1,2,3],\"ttt\":[{\"key\":\"abc\",\"value\":\"efg\"},{\"key\":\"hck\",\"value\":\"qwe\"},{\"key\":\"zxc\",\"value\":\"vbn\",\"last\":true}]}"                   (S.simpleParamsToJson "abc:123,efg:456,zxc:[1,2,3],ttt:[abc#efg,hck#qwe,zxc#vbn@]")    , testCase "simple params with a space" $       assertEqual "Checking simple params with a space"-                  "{\"props\":[{\"name\":\"cover\",\"type\":\"Text\"}, {\"name\":\"year\",\"type\":\"Integer\",\"last\":true}]}"+                  "{\"props\":[{\"key\":\"cover\",\"value\":\"Text\"}, {\"key\":\"year\",\"value\":\"Integer\",\"last\":true}]}"                   (S.simpleParamsToJson "props:[cover#Text, year#Integer@]")    ]
trurl.cabal view
@@ -1,14 +1,10 @@ name:                trurl-version:             0.4.0.1+version:             0.4.1.0 synopsis:            Haskell template code generator description:     Trurl is a haskell project and code generating utility. Use it for scaffolding your projects and entities.     Quick start:     .-            cabal update-    .        -            cabal install trurl-    .                     trurl new project MyProject haskeleton     .             Trurl allows creating your own templates for projects as well as for files.