trurl 0.3.1.0 → 0.4.0.0

raw patch · 6 files changed

+134/−149 lines, 6 filesdep +filepathdep +hastache-aesondep +splitdep −scientificPVP ok

version bump matches the API change (PVP)

Dependencies added: filepath, hastache-aeson, split

Dependencies removed: scientific

API changes (from Hackage documentation)

Files

• src/Main.hs +11/−10
• src/Registry.hs +16/−0
• src/SimpleParams.hs +22/−27
• src/Trurl.hs +57/−77
• tests/Main.hs +22/−32
• trurl.cabal +6/−3

@@ -11,17 +11,17 @@ help = do   putStrLn "trurl <command> [parameters]"   putStrLn "  update -- fetch the updates from repository"-  putStrLn "  create <name> <project_template> -j [parameters_string] -- create project of specified type with specified name; optionally add JSON parameters, wrap it with \"\" or ''"-  putStrLn "  create <name> <project_template> [parameters] -- create project of specified type with specified name; optionally add parameters"-  putStrLn "  new <name> <file_template> -j [parameters_string] -- create file from the template with specified JSON parameters, wrap it with \"\" or ''"-  putStrLn "  new <name> <file_template> [parameters] -- create file from the template with specified string parameters"+  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 file <name> <file_template> [parameters] -- create file from the template with specified string parameters"   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.3.0.x"+printVersion = putStrLn "0.4.0.x"  main :: IO () main = do@@ -31,12 +31,13 @@     ["help"]                                -> help     ["help", template]                      -> helpTemplate template     ["update"]                              -> updateFromRepository-    ["create", name, project]               -> createProject name project "{}"-    ["create", name, project, "-j", params] -> createProject name project params-    ("create": name: project: params)       -> createProject name project $ simpleParamsToJson $ foldr (\a b -> a ++ " " ++ b) "" params-    ["new", name, template, "-j" ,params]   -> newTemplate name template params-    ("new": name: template: params)         -> newTemplate name template $ simpleParamsToJson $ foldr (\a b -> a ++ " " ++ b) "" params+    ["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", "file", name, template, "-j" ,params]   -> newTemplate name template params+    ("new file": name: template: params)    -> newTemplate name template $ simpleParamsToJson $ unwords params     ["list"]                                -> listTemplates     ["version"]                             -> printVersion+    ["--version"]                           -> printVersion     ["-v"]                                  -> printVersion     _                                       -> putStrLn "Unknown command"

@@ -0,0 +1,16 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE DeriveGeneric #-}++module Registry where++import Data.Aeson+import GHC.Generics (Generic)++data Registry = Registry { url :: String+                         , templateName :: String+                         , metainfoName :: String+                         }+  deriving (Show, Generic)                ++instance ToJSON Registry+instance FromJSON Registry

@@ -2,40 +2,35 @@  module SimpleParams where -import Data.List hiding (find)-import Data.String.Utils+import Data.List.Split+import Data.String.Utils (endswith, replace) import Safe import Data.Char  parseEmbedded :: String -> String parseEmbedded str =-  let splitted = split "#" str-  in if length splitted /= 2 then ""-     else if endswith "@" (splitted !! 1) then "{\"name\":\"" ++ splitted !! 0 ++ "\",\"type\":\"" ++ (replace "@" "" $ splitted !! 1) ++ "\",\"last\":true}"-          else "{\"name\":\"" ++ splitted !! 0 ++ "\",\"type\":\"" ++ splitted !! 1 ++ "\"}"+  case splitOn "#" str of+    [name, typ] ->+      if endswith "@" typ+        then "{\"name\":\"" ++ name ++ "\",\"type\":\"" ++ replace "@" "" typ ++ "\",\"last\":true}"+        else "{\"name\":\"" ++ name ++ "\",\"type\":\"" ++ typ ++ "\"}"+    _ -> ""  processPart :: String -> String-processPart str = -  let symb = headDef ' ' str-  in if isDigit symb then str-     else if symb == ','-           || symb == '['-           || symb == '{'-           || symb == ']'-           || symb == '}'-           || symb == ':'-             then str-          else if "#" `isInfixOf` str then parseEmbedded str-               else "\"" ++ str ++ "\""+processPart str+    | isDigit symb                  = str+    | symb `elem` specialCharacters = str+    | '#'  `elem` str               = parseEmbedded str+    | otherwise                     = "\"" ++ str ++ "\""+  where+    symb = headDef ' ' str  simpleParamsToJson :: String -> String-simpleParamsToJson sparams = -  let s =  (replace "," " , ") -         . (replace "[" " [ ") -         . (replace "{" " { ") -         . (replace "]" " ] ") -         . (replace "}" " } ") -         . (replace ":" " : ") -         $ sparams      -  in "{" ++  (foldl (++) "" $ map processPart  $ splitWs s) ++ "}"+simpleParamsToJson sparams =+    "{" ++  concatMap processPart (splitOnSpecialCharacters sparams) ++ "}" +splitOnSpecialCharacters :: String -> [String]+splitOnSpecialCharacters = split $ dropBlanks $ oneOf specialCharacters++specialCharacters :: [Char]+specialCharacters = ",:[]{} "

@@ -2,39 +2,36 @@  module Trurl where -import GHC.Exts import System.Directory+import System.FilePath import Network.HTTP.Conduit import Codec.Archive.Tar import Data.List hiding (find) import Text.Hastache-import Text.Hastache.Context+import Text.Hastache.Aeson import Data.Aeson-import Data.Scientific 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.IO as T import qualified Data.Text.Lazy.IO as TL import qualified Data.ByteString.Lazy as BL import qualified Data.ByteString.Lazy.Char8 as BLC8-import qualified Data.HashMap.Strict as HM +import Registry+ constProjectName :: String constProjectName = "ProjectName" -mainRepoFile :: String-mainRepoFile = "mainRepo.tar"--mainRepo :: String-mainRepo = "https://github.com/dbushenko/trurl/raw/master/repository/" ++ mainRepoFile+registryUrl :: String+registryUrl = "https://github.com/dbushenko/trurl/raw/master/repository/registry.json"  templateExt :: String templateExt = ".template" -getLocalRepoDir :: IO String+getLocalRepoDir :: IO FilePath getLocalRepoDir = do   home <- getHomeDirectory   return $ home ++ "/.trurl/repo/"@@ -47,74 +44,59 @@ printFileHeader :: FilePath -> FilePath -> IO () printFileHeader dir fp = do   file <- readFile (dir ++ fp)-  putStrLn $ headDef "No info found..." $ split "\n" file--cutExtension :: String -> String -> String-cutExtension filePath ext = take (length filePath - length ext) filePath--cutSuffix :: String -> String -> String-cutSuffix suffix fname =-  if endswith suffix fname then take (length fname - length suffix) fname-  else fname--extractFileNameFromPath :: String -> String-extractFileNameFromPath fpath =-  let mn = elemIndex '/' $ reverse fpath-      extractExt Nothing = fpath-      extractExt (Just n) = drop ((length fpath) - n) fpath-  in extractExt mn+  putStrLn $ headDef "No info found..." $ lines file -processTemplate :: String -> String -> String -> IO ()+processTemplate :: String -> String -> FilePath -> IO () processTemplate projName paramsStr filePath  = do-  template <- T.readFile filePath-  generated <- hastacheStr defaultConfig template (mkStrContext (mkProjContext projName paramsStr))-  TL.writeFile (cutExtension filePath templateExt) generated+  generated <- hastacheFile defaultConfig filePath (mkProjContext projName paramsStr)+  TL.writeFile (dropExtension filePath) generated   removeFile filePath   return () -getFileName :: String -> String+getFileName :: FilePath -> FilePath getFileName template =-  if "." `isInfixOf` template then template-  else template ++ ".hs"+  if hasExtension template+    then template+    else template <.> "hs" -getFullFileName :: String -> String -> String+getFullFileName :: FilePath -> String -> FilePath getFullFileName repoDir template = repoDir ++ getFileName template -mkVariable :: Monad m => Value -> MuType m-mkVariable (String s) = MuVariable s-mkVariable (Bool b) = MuBool b-mkVariable (Number n) = let e = floatingOrInteger n-                            mkval (Left r) = MuVariable (r :: Double)-                            mkval (Right i) = MuVariable (i :: Integer)-                        in mkval e--mkVariable (Array ar) = mkMuList (toList ar)-mkVariable o@(Object _) = mkMuList [o]-mkVariable Null = MuVariable ("" :: String)+mkJsonContext :: Monad m => String -> MuContext m+mkJsonContext =+  maybe mkEmptyContext jsonValueContext . decode . BLC8.pack -mkMuList :: Monad m => [Value] -> MuType m-mkMuList = MuList . map (mkStrContext . aesonContext)+mkEmptyContext :: Monad m => MuContext m+mkEmptyContext = const $ return MuNothing -aesonContext :: Monad m => Value -> String -> MuType m-aesonContext obj k  = -  case obj of-    (Object o) -> mkVariable $ HM.lookupDefault Null (T.pack k) o-    _          -> mkVariable Null+mkProjContext :: Monad m => String -> String -> MuContext m+mkProjContext projName paramsStr =+  assoc "ProjectName" projName $ mkJsonContext paramsStr -mkContext :: Monad m => String -> String -> MuType m-mkContext paramsStr key =-  case decode $ BLC8.pack paramsStr of-    Nothing  -> MuVariable ("" :: String)-    Just obj -> aesonContext obj key+mkFileContext :: Monad m => FilePath -> String -> MuContext m+mkFileContext fname paramsStr =+  assoc "FileName" fname $ mkJsonContext paramsStr -mkProjContext :: Monad m => String -> String -> String -> MuType m-mkProjContext projName _ "ProjectName" = MuVariable projName-mkProjContext _ paramsStr key             = mkContext paramsStr key+assoc :: (Monad m, MuVar a) => T.Text -> a -> MuContext m -> MuContext m+assoc newKey newVal oldCtx k =+  if k == newKey+    then return $ MuVariable newVal+    else oldCtx k +substituteProjectName :: String -> FilePath -> FilePath+substituteProjectName projectName filePath  =+  let (dirName, oldFileName) = splitFileName filePath+      newFileName = replace constProjectName projectName oldFileName+   in dirName </> newFileName -mkFileContext :: Monad m => String -> String -> String -> MuType m-mkFileContext fname _ "FileName" = MuVariable fname-mkFileContext _ paramsStr key     = mkContext paramsStr key+downloadTemplate :: String -> Registry -> IO ()+downloadTemplate repoDir (Registry url tname mname) = do+    let tFile = repoDir ++ tname+        mFile = repoDir ++ mname+        fullUrl = if endswith "/" url then url else url ++ "/"+    putStrLn $ "Fetching " ++ fullUrl ++ tname+    simpleHttp (fullUrl ++ tname) >>= BL.writeFile tFile+    simpleHttp (fullUrl ++ mname) >>= BL.writeFile mFile  ------------------------------------- -- API@@ -122,18 +104,20 @@  -- Команда "update" -- 1) Создать $HOME/.trurl/repo--- 2) Забрать из репозитория свежий tar-архив с апдейтами--- 3) Распаковать его в $HOME/.trurl/repo+-- 2) Забрать из репозитория реестр шаблонов+-- 3) Распарсить реестр как json+-- 4) Для каждого элемента реестра скачать шаблон и metainfo -- updateFromRepository :: IO () updateFromRepository = do   repoDir <- getLocalRepoDir   createDirectoryIfMissing True repoDir-  let tarFile = repoDir ++ mainRepoFile-  simpleHttp mainRepo >>= BL.writeFile tarFile-  extract repoDir tarFile-  removeFile tarFile-+  putStrLn "Fetching registry..."+  regFile <- simpleHttp registryUrl+  case eitherDecode regFile :: Either String [Registry] of+      Left msg -> putStrLn $ "Can't parse registry file!\n" ++ msg+      Right registry -> mapM_ (downloadTemplate repoDir) registry+   -- Команда "create <name> <project> [parameters]" -- 1) Найти в $HOME/.trurl/repo архив с именем project.tar -- 2) Создать директорию ./name@@ -161,10 +145,7 @@   projNamePaths <- find always (liftOp checkFileName fileName constProjectName) name    -- Rename 'ProjectName' files-  let renameProjNameFile fpath = let fname = extractFileNameFromPath fpath-                                     fdir = cutSuffix fname fpath-                                     newfname = replace constProjectName name fname-                                 in renameFile fpath (fdir ++ newfname)+  let renameProjNameFile fpath = renameFile fpath (substituteProjectName name fpath)   mapM_ renameProjNameFile projNamePaths  @@ -179,8 +160,7 @@ newTemplate name templateName paramsStr = do   repoDir <- getLocalRepoDir   let templPath = getFullFileName repoDir templateName-  template <- T.readFile templPath-  generated <- hastacheStr defaultConfig template (mkStrContext (mkFileContext name paramsStr))+  generated <- hastacheFile defaultConfig templPath (mkFileContext name paramsStr)   TL.writeFile (getFileName name) generated  -- Команда "list"

@@ -4,8 +4,7 @@  import Test.Tasty import Test.Tasty.HUnit-import Text.Hastache -import Text.Hastache.Context+import Text.Hastache  import qualified Trurl as T import qualified SimpleParams as S@@ -18,22 +17,7 @@  trurlTests :: TestTree trurlTests = testGroup "Trurl unit tests"-  [ testCase "cutExtension" $-      assertEqual "Checking file name without extension" "a/b" (T.cutExtension "a/b.hs" ".hs")--  , testCase "cutSuffix" $-      assertEqual "Checking file name with suffix" "projectName" (T.cutSuffix "Bench.hs" "projectNameBench.hs")--  , testCase "cutSuffix" $-      assertEqual "Checking file name without suffix" "projectNameBench.hs" (T.cutSuffix "Bench.hs123" "projectNameBench.hs")--  , testCase "extractFileNameFromPath" $-      assertEqual "Checking file name in directory" "my.hs" (T.extractFileNameFromPath "e/f/my.hs")-      -  , testCase "extractFileNameFromPath" $-      assertEqual "Checking file name without directory" "my.hs" (T.extractFileNameFromPath "my.hs")-      -  , testCase "getFullFileName" $+  [ testCase "getFullFileName" $       assertEqual "Checking full template path" "a/b.hs" (T.getFullFileName "a/" "b")    , testCase "getFileName" $@@ -42,32 +26,32 @@   , testCase "getFileName" $       assertEqual "Checking file name" "abc.html" (T.getFileName "abc.html") -  , testCase "mkContext empty" $ do-      generated <- hastacheStr defaultConfig "" (mkStrContext (T.mkContext "{\"a\":11}"))+  , testCase "mkJsonContext empty" $ do+      generated <- hastacheStr defaultConfig "" (T.mkJsonContext "{\"a\":11}")       assertEqual "Checking generated text" "" generated -  , testCase "mkContext absent variable" $ do-      generated <- hastacheStr defaultConfig "{{b}}" (mkStrContext (T.mkContext "{\"a\":11}"))+  , testCase "mkJsonContext absent variable" $ do+      generated <- hastacheStr defaultConfig "{{b}}" (T.mkJsonContext "{\"a\":11}")       assertEqual "Checking generated text" "" generated -  , testCase "mkContext simple object" $ do-      generated <- hastacheStr defaultConfig "{{a}}" (mkStrContext (T.mkContext "{\"a\":11}"))+  , testCase "mkJsonContext simple object" $ do+      generated <- hastacheStr defaultConfig "{{a}}" (T.mkJsonContext "{\"a\":11}")       assertEqual "Checking generated text" "11" generated -  , testCase "mkContext complex object" $ do-      generated <- hastacheStr defaultConfig "{{a}}-{{b}}" (mkStrContext (T.mkContext "{\"a\":11,\"b\":\"abc\"}"))+  , testCase "mkJsonContext complex object" $ do+      generated <- hastacheStr defaultConfig "{{a}}-{{b}}" (T.mkJsonContext "{\"a\":11,\"b\":\"abc\"}")       assertEqual "Checking generated text" "11-abc" generated -  , testCase "mkContext complex array" $ do-      generated <- hastacheStr defaultConfig "{{#abc}}{{name}}{{/abc}}" (mkStrContext (T.mkContext "{\"abc\":[{\"name\":\"1\"},{\"name\":\"2\"},{\"name\":\"3\"}]}"))+  , testCase "mkJsonContext complex array" $ do+      generated <- hastacheStr defaultConfig "{{#abc}}{{name}}{{/abc}}" (T.mkJsonContext "{\"abc\":[{\"name\":\"1\"},{\"name\":\"2\"},{\"name\":\"3\"}]}")       assertEqual "Checking generated text" "123" generated -  , testCase "mkContext nested object" $ do-      generated <- hastacheStr defaultConfig "{{#abc}}{{name}}{{/abc}}" (mkStrContext (T.mkContext "{\"abc\":{\"name\":\"1\"}}"))+  , testCase "mkJsonContext nested object" $ do+      generated <- hastacheStr defaultConfig "{{#abc}}{{name}}{{/abc}}" (T.mkJsonContext "{\"abc\":{\"name\":\"1\"}}")       assertEqual "Checking generated text" "1" generated    , testCase "mkProjContext for empty params" $ do-      generated <- hastacheStr defaultConfig "{{ProjectName}}" (mkStrContext (T.mkProjContext "abc" "{}"))+      generated <- hastacheStr defaultConfig "{{ProjectName}}" (T.mkProjContext "abc" "{}")       assertEqual "Checking generated text" "abc" generated   ] @@ -84,7 +68,13 @@       assertEqual "Checking parseEmbedded" "{\"name\":\"abc\",\"type\":\"efg\",\"last\":true}" (S.parseEmbedded "abc#efg@")    , testCase "simpleParamsToJson" $-      assertEqual "Checking 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}]}"                   (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}]}"+                  (S.simpleParamsToJson "props:[cover#Text, year#Integer@]")+   ]

@@ -1,5 +1,5 @@ name:                trurl-version:             0.3.1.0+version:             0.4.0.0 synopsis:            Haskell template code generator description:     Trurl is a haskell project and code generating utility. Use it for scaffolding your projects and entities.@@ -28,6 +28,7 @@        exposed-modules:     Trurl                      , SimpleParams+                     , Registry                         hs-source-dirs:      src   build-depends:       base >= 4.7 && < 5@@ -38,12 +39,14 @@                      , tar                      , hastache                      , aeson-                     , scientific+                     , hastache-aeson                      , unordered-containers                      , MissingH                      , filemanip                      , safe-                     +                     , filepath+                     , split+   default-language:    Haskell2010