packages feed

trurl 0.2.2.0 → 0.3.0.0

raw patch · 5 files changed

+132/−30 lines, 5 filesdep +safe

Dependencies added: safe

Files

src/Main.hs view
@@ -3,28 +3,44 @@ module Main where  import Trurl+import SimpleParams+ import System.Environment  help :: IO () help = do   putStrLn "trurl <command> [parameters]"   putStrLn "  update -- fetch the updates from repository"-  putStrLn "  create <name> <project_template> [parameters_string] -- create project of specified type with specified name; optionally add JSON parameters"-  putStrLn "  new <name> <template> [parameters_string] -- create file from the template with specified parameters, wrap it with \"\""+  putStrLn "  create <name> <project_template> -j [parameters_string] -- create project of specified type with specified name; optionally add JSON parameters"+  putStrLn "  create <name> <project_template> -s [parameters_string] -- create project of specified type with specified name; optionally add string parameters"+  putStrLn "  create <name> <project_template> [parameters_string] -- create project of specified type with specified name; optionally add string 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> -s [parameters_string] -- create file from the template with specified string parameters, wrap it with \"\" or ''"+  putStrLn "  new <name> <file_template> [parameters_string] -- create file from the template with specified string 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.3.0.0"+ main :: IO () main = do   args <- getArgs   case args of-    []                                -> help-    ["help"]                          -> help-    ["help", template]                -> helpTemplate template-    ["update"]                        -> updateFromRepository-    ["create", name, project]         -> createProject name project "{}"-    ["create", name, project, params] -> createProject name project params-    ["new", name, template, params]   -> newTemplate name template params-    ["list"]                          -> listTemplates-    _                                 -> putStrLn "Unknown command"+    []                                      -> help+    ["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, "-s", params] -> createProject name project $ simpleParamsToJson params+    ["create", name, project, params]       -> createProject name project $ simpleParamsToJson params+    ["new", name, template, "-j" ,params]   -> newTemplate name template params+    ["new", name, template, "-s" ,params]   -> newTemplate name template $ simpleParamsToJson params+    ["new", name, template, params]         -> newTemplate name template $ simpleParamsToJson params+    ["list"]                                -> listTemplates+    ["version"]                             -> printVersion+    ["-v"]                                  -> printVersion+    _                                       -> putStrLn "Unknown command"
+ src/SimpleParams.hs view
@@ -0,0 +1,41 @@+{-# LANGUAGE OverloadedStrings #-}++module SimpleParams where++import Data.List hiding (find)+import Data.String.Utils+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 ++ "\"}"++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 ++ "\""++simpleParamsToJson :: String -> String+simpleParamsToJson sparams = +  let s =  (replace "," " , ") +         . (replace "[" " [ ") +         . (replace "{" " { ") +         . (replace "]" " ] ") +         . (replace "}" " } ") +         . (replace ":" " : ") +         $ sparams      +  in "{" ++  (foldl (++) "" $ map processPart  $ splitWs s) ++ "}"+
src/Trurl.hs view
@@ -10,10 +10,10 @@ import Text.Hastache import Text.Hastache.Context import Data.Aeson-import Data.Maybe import Data.Scientific import Data.String.Utils import System.FilePath.Find (find, always, fileName, extension, (==?), liftOp)+import Safe  import qualified Data.Text as T import qualified Data.Text.IO as T@@ -47,7 +47,7 @@ printFileHeader :: FilePath -> FilePath -> IO () printFileHeader dir fp = do   file <- readFile (dir ++ fp)-  putStrLn $ head $ split "\n" file+  putStrLn $ headDef "No info found..." $ split "\n" file  cutExtension :: String -> String -> String cutExtension filePath ext = take (length filePath - length ext) filePath@@ -88,26 +88,34 @@                             mkval (Right i) = MuVariable (i :: Integer)                         in mkval e -mkVariable (Array ar) = MuList $ map (mkStrContext . aesonContext . Just) (toList ar)-mkVariable o@(Object _) = MuList [ mkStrContext $ aesonContext $ Just o ]+mkVariable (Array ar) = mkMuList (toList ar)+mkVariable o@(Object _) = mkMuList [o] mkVariable Null = MuVariable ("" :: String) -aesonContext :: Monad m => Maybe Value -> String -> MuType m-aesonContext mobj k = let obj = fromJust mobj-                          Object o = obj-                          v = HM.lookupDefault Null (T.pack k) o-                      in mkVariable v+mkMuList :: Monad m => [Value] -> MuType m+mkMuList = MuList . map (mkStrContext . aesonContext) +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+ mkContext :: Monad m => String -> String -> MuType m-mkContext paramsStr =-  let mobj = decode (BLC8.pack paramsStr) :: Maybe Value-  in if isNothing mobj then \_ -> MuVariable ("" :: String)-     else aesonContext mobj+mkContext paramsStr key =+  case decode $ BLC8.pack paramsStr of+    Nothing  -> MuVariable ("" :: String)+    Just obj -> aesonContext obj key  mkProjContext :: Monad m => String -> String -> String -> MuType m mkProjContext projName _ "ProjectName" = MuVariable projName mkProjContext _ paramsStr key             = mkContext paramsStr key ++mkFileContext :: Monad m => String -> String -> String -> MuType m+mkFileContext fname _ "FileName" = MuVariable fname+mkFileContext _ paramsStr key     = mkContext paramsStr key+ ------------------------------------- -- API --@@ -172,7 +180,7 @@   repoDir <- getLocalRepoDir   let templPath = getFullFileName repoDir templateName   template <- T.readFile templPath-  generated <- hastacheStr defaultConfig template (mkStrContext (mkContext paramsStr))+  generated <- hastacheStr defaultConfig template (mkStrContext (mkFileContext name paramsStr))   TL.writeFile (getFileName name) generated  -- Команда "list"
tests/Main.hs view
@@ -8,15 +8,16 @@ import Text.Hastache.Context  import qualified Trurl as T+import qualified SimpleParams as S  main :: IO () main = defaultMain tests  tests :: TestTree-tests = testGroup "Tests" [unitTests]+tests = testGroup "Tests" [trurlTests, simplParamsTests] -unitTests :: TestTree-unitTests = testGroup "Unit tests"+trurlTests :: TestTree+trurlTests = testGroup "Trurl unit tests"   [ testCase "cutExtension" $       assertEqual "Checking file name without extension" "a/b" (T.cutExtension "a/b.hs" ".hs") @@ -68,4 +69,22 @@   , testCase "mkProjContext for empty params" $ do       generated <- hastacheStr defaultConfig "{{ProjectName}}" (mkStrContext (T.mkProjContext "abc" "{}"))       assertEqual "Checking generated text" "abc" generated+  ]+++simplParamsTests :: TestTree+simplParamsTests = testGroup "Trurl unit tests"+  [ testCase "parseEmbedded without delimiter" $+      assertEqual "Checking parseEmbedded" "" (S.parseEmbedded "abc")++  , testCase "parseEmbedded with delimiter" $+      assertEqual "Checking parseEmbedded" "{\"name\":\"abc\",\"type\":\"efg\"}" (S.parseEmbedded "abc#efg")++  , testCase "parseEmbedded with delimiter" $+      assertEqual "Checking parseEmbedded" "{\"name\":\"abc\",\"type\":\"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}]}"+                  (S.simpleParamsToJson "abc:123,efg:456,zxc:[1,2,3],ttt:[abc#efg,hck#qwe,zxc#vbn!]")   ]
trurl.cabal view
@@ -1,7 +1,21 @@ name:                trurl-version:             0.2.2.0+version:             0.3.0.0 synopsis:            Haskell template code generator--- description:         +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 create MyProject scotty-mysql+            cd MyProject/src+            trurl new Comment scotty-entity 'props:[comment#String, author#String!]'+    .+    Trurl allows creating your own templates for projects as well as for files. Just put them to ~/.trurl/repo.       +    .+    For more details read here http://github.com/dbushenko/trurl+     homepage:            http://github.com/dbushenko/trurl license:             BSD3 license-file:        LICENSE@@ -14,7 +28,10 @@ cabal-version:       >=1.10  library+       exposed-modules:     Trurl+                     , SimpleParams+                        hs-source-dirs:      src   build-depends:       base >= 4.7 && < 5                      , http-conduit@@ -28,6 +45,7 @@                      , unordered-containers                      , MissingH                      , filemanip+                     , safe                         default-language:    Haskell2010