trurl 0.1.0.0 → 0.2.0.0
raw patch · 4 files changed
+163/−76 lines, 4 filesdep +filemanipdep ~basePVP ok
version bump matches the API change (PVP)
Dependencies added: filemanip
Dependency ranges changed: base
API changes (from Hackage documentation)
+ Trurl: constProjectName :: String
+ Trurl: cutExtension :: String -> String -> String
+ Trurl: cutSuffix :: String -> String -> String
+ Trurl: extractFileNameFromPath :: String -> String
+ Trurl: mkProjContext :: Monad m => String -> String -> String -> MuType m
+ Trurl: processTemplate :: String -> String -> String -> IO ()
+ Trurl: templateExt :: String
- Trurl: createProject :: String -> String -> IO ()
+ Trurl: createProject :: String -> String -> String -> IO ()
- Trurl: mkVariable :: Monad m => Maybe Value -> MuType m
+ Trurl: mkVariable :: Monad m => Value -> MuType m
Files
- src/Main.hs +12/−11
- src/Trurl.hs +118/−52
- tests/Main.hs +28/−6
- trurl.cabal +5/−7
src/Main.hs view
@@ -9,21 +9,22 @@ help = do putStrLn "trurl <command> [parameters]" putStrLn " update -- fetch the updates from repository"- putStrLn " create <name> <project_template> -- create project of specified type with specified name"- putStrLn " new <name> <template> <parameters_string> -- create file from the template with specified parameters, wrap it with \"\""+ 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 " list -- print all available templates" putStrLn " help <template> -- print template info" putStrLn " help -- print this help"- + main :: IO () main = do args <- getArgs case args of- [] -> help- ["help"] -> help- ["help", template] -> helpTemplate template- ["update"] -> updateFromRepository- ["create", name, project] -> createProject name project- ["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, params] -> createProject name project params+ ["new", name, template, params] -> newTemplate name template params+ ["list"] -> listTemplates+ _ -> putStrLn "Unknown command"
src/Trurl.hs view
@@ -6,13 +6,14 @@ import System.Directory import Network.HTTP.Conduit import Codec.Archive.Tar-import Data.List-import Text.Hastache +import Data.List hiding (find)+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 qualified Data.Text as T import qualified Data.Text.IO as T@@ -21,50 +22,55 @@ import qualified Data.ByteString.Lazy.Char8 as BLC8 import qualified Data.HashMap.Strict as HM +constProjectName :: String+constProjectName = "ProjectName"+ mainRepoFile :: String mainRepoFile = "mainRepo.tar" mainRepo :: String mainRepo = "https://github.com/dbushenko/trurl/raw/master/repository/" ++ mainRepoFile +templateExt :: String+templateExt = ".template"+ getLocalRepoDir :: IO String getLocalRepoDir = do home <- getHomeDirectory return $ home ++ "/.trurl/repo/"- --- Команда "update"--- 1) Создать $HOME/.trurl/repo--- 2) Забрать из репозитория свежий tar-архив с апдейтами--- 3) Распаковать его в $HOME/.trurl/repo+printFile :: FilePath -> FilePath -> IO ()+printFile dir fp = do+ file <- readFile (dir ++ fp)+ putStrLn file -updateFromRepository :: IO ()-updateFromRepository = do- repoDir <- getLocalRepoDir- createDirectoryIfMissing True repoDir- let tarFile = repoDir ++ mainRepoFile- simpleHttp mainRepo >>= BL.writeFile tarFile- extract repoDir tarFile- removeFile tarFile+printFileHeader :: FilePath -> FilePath -> IO ()+printFileHeader dir fp = do+ file <- readFile (dir ++ fp)+ putStrLn $ head $ split "\n" file +cutExtension :: String -> String -> String+cutExtension filePath ext = take (length filePath - length ext) filePath --- Команда "create <project> <name>"--- 1) Найти в $HOME/.trurl/repo архив с именем project.tar--- 2) Создать дирректорию ./name--- 3) Распаковать в ./name содержимое project.tar+cutSuffix :: String -> String -> String+cutSuffix suffix fname =+ if endswith suffix fname then take (length fname - length suffix) fname+ else fname -createProject :: String -> String -> IO ()-createProject name project = do- repoDir <- getLocalRepoDir- createDirectoryIfMissing True name- extract name $ repoDir ++ project ++ ".tar"+extractFileNameFromPath :: String -> String+extractFileNameFromPath fpath =+ let mn = elemIndex '/' $ reverse fpath+ extractExt Nothing = fpath+ extractExt (Just n) = drop ((length fpath) - n) fpath+ in extractExt mn --- Команда "new <file> <parameters>"--- 1) Найти в $HOME/.trurl/repo архив с именем file.hs.--- Если имя файла передано с расширением, то найти точное имя файла, не подставляя *.hs--- 2) Прочитать содержимое шаблона--- 3) Отрендерить его с применением hastache и переденных параметров--- 4) Записать файл в ./+processTemplate :: String -> String -> String -> IO ()+processTemplate projName paramsStr filePath = do+ template <- T.readFile filePath+ generated <- hastacheStr defaultConfig template (mkStrContext (mkProjContext projName paramsStr))+ TL.writeFile (cutExtension filePath templateExt) generated+ removeFile filePath+ return () getFileName :: String -> String getFileName template =@@ -74,23 +80,22 @@ getFullFileName :: String -> String -> String getFullFileName repoDir template = repoDir ++ getFileName template -mkVariable :: Monad m => Maybe Value -> MuType m-mkVariable (Just (String s)) = MuVariable s-mkVariable (Just (Bool b)) = MuBool b-mkVariable (Just (Number n)) = let e = floatingOrInteger n- mkval (Left r) = MuVariable (r :: Double)- mkval (Right i) = MuVariable (i :: Integer)- in mkval e+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 (Just (Array ar)) = MuList $ map (mkStrContext . aesonContext . Just) (toList ar)-mkVariable (Just o@(Object _)) = MuList [ mkStrContext $ aesonContext $ Just o ]-mkVariable (Just Null) = MuVariable ("" :: String) -mkVariable Nothing = MuVariable ("" :: String)+mkVariable (Array ar) = MuList $ map (mkStrContext . aesonContext . Just) (toList ar)+mkVariable o@(Object _) = MuList [ mkStrContext $ aesonContext $ Just 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.lookup (T.pack k) o+ v = HM.lookupDefault Null (T.pack k) o in mkVariable v mkContext :: Monad m => String -> String -> MuType m@@ -99,6 +104,69 @@ in if isNothing mobj then \_ -> MuVariable ("" :: String) else aesonContext mobj +mkProjContext :: Monad m => String -> String -> String -> MuType m+mkProjContext projName _ "ProjectName" = MuVariable projName+mkProjContext _ paramsStr key = mkContext paramsStr key++-------------------------------------+-- API+--++-- Команда "update"+-- 1) Создать $HOME/.trurl/repo+-- 2) Забрать из репозитория свежий tar-архив с апдейтами+-- 3) Распаковать его в $HOME/.trurl/repo+--+updateFromRepository :: IO ()+updateFromRepository = do+ repoDir <- getLocalRepoDir+ createDirectoryIfMissing True repoDir+ let tarFile = repoDir ++ mainRepoFile+ simpleHttp mainRepo >>= BL.writeFile tarFile+ extract repoDir tarFile+ removeFile tarFile++-- Команда "create <name> <project> [parameters]"+-- 1) Найти в $HOME/.trurl/repo архив с именем project.tar+-- 2) Создать директорию ./name+-- 3) Распаковать в ./name содержимое project.tar+-- 4) Найти все файлы с расширением ".template"+-- 5) Отрендерить эти темплейты c учетом переданных parameters+-- 6) Сохранить отрендеренные файлы в новые файлы без ".template"+-- 7) Удалить все файлы с расширением ".template"+-- 8) Найти все файлы с именем ProjectName независимо от расширения+-- 9) Переименовать эти файлы в соотествии с указанным ProjectName+--+createProject :: String -> String -> String -> IO ()+createProject name project paramsStr = do+ -- Extract the archive+ repoDir <- getLocalRepoDir+ createDirectoryIfMissing True name+ extract name $ repoDir ++ project ++ ".tar"++ -- Process all templates+ templatePaths <- find always (extension ==? templateExt) name+ mapM_ (processTemplate name paramsStr) templatePaths++ -- Find 'ProjectName' files+ let checkFileName fname templname = isInfixOf templname fname+ 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)+ mapM_ renameProjNameFile projNamePaths+++-- Команда "new <file> [parameters]"+-- 1) Найти в $HOME/.trurl/repo архив с именем file.hs.+-- Если имя файла передано с расширением, то найти точное имя файла, не подставляя *.hs+-- 2) Прочитать содержимое шаблона+-- 3) Отрендерить его с применением hastache и переданных параметров+-- 4) Записать файл в ./+-- newTemplate :: String -> String -> String -> IO () newTemplate name templateName paramsStr = do repoDir <- getLocalRepoDir@@ -107,16 +175,10 @@ generated <- hastacheStr defaultConfig template (mkStrContext (mkContext paramsStr)) TL.writeFile (getFileName name) generated -printFile :: FilePath -> FilePath -> IO ()-printFile dir fp = do- file <- readFile (dir ++ fp)- putStrLn file --printFileHeader :: FilePath -> FilePath -> IO ()-printFileHeader dir fp = do- file <- readFile (dir ++ fp)- putStrLn $ head $ split "\n" file-+-- Команда "list"+-- 1) Найти все файлы с расширением '.metainfo'+-- 2) Для каждого найденного файла вывести первую строчку+-- listTemplates :: IO () listTemplates = do repoDir <- getLocalRepoDir@@ -124,6 +186,10 @@ let mpaths = filter (endswith ".metainfo") files mapM_ (printFileHeader repoDir) mpaths +-- Команда "help <template>"+-- 1) Найти указанный файл с расширением '.metainfo'+-- 2) Вывести его содержимое+-- helpTemplate :: String -> IO () helpTemplate template = do repoDir <- getLocalRepoDir
tests/Main.hs view
@@ -17,7 +17,22 @@ unitTests :: TestTree unitTests = testGroup "Unit tests"- [ testCase "getFullFileName" $+ [ 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" $ assertEqual "Checking full template path" "a/b.hs" (T.getFullFileName "a/" "b") , testCase "getFileName" $@@ -28,22 +43,29 @@ , testCase "mkContext empty" $ do generated <- hastacheStr defaultConfig "" (mkStrContext (T.mkContext "{\"a\":11}"))- assertEqual "Checking generated text" generated ""+ assertEqual "Checking generated text" "" generated + , testCase "mkContext absent variable" $ do+ generated <- hastacheStr defaultConfig "{{b}}" (mkStrContext (T.mkContext "{\"a\":11}"))+ assertEqual "Checking generated text" "" generated+ , testCase "mkContext simple object" $ do generated <- hastacheStr defaultConfig "{{a}}" (mkStrContext (T.mkContext "{\"a\":11}"))- assertEqual "Checking generated text" generated "11"+ assertEqual "Checking generated text" "11" generated , testCase "mkContext complex object" $ do generated <- hastacheStr defaultConfig "{{a}}-{{b}}" (mkStrContext (T.mkContext "{\"a\":11,\"b\":\"abc\"}"))- assertEqual "Checking generated text" generated "11-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\"}]}"))- assertEqual "Checking generated text" generated "123"+ assertEqual "Checking generated text" "123" generated , testCase "mkContext nested object" $ do generated <- hastacheStr defaultConfig "{{#abc}}{{name}}{{/abc}}" (mkStrContext (T.mkContext "{\"abc\":{\"name\":\"1\"}}"))- assertEqual "Checking generated text" generated "1"+ assertEqual "Checking generated text" "1" generated + , testCase "mkProjContext for empty params" $ do+ generated <- hastacheStr defaultConfig "{{ProjectName}}" (mkStrContext (T.mkProjContext "abc" "{}"))+ assertEqual "Checking generated text" "abc" generated ]
trurl.cabal view
@@ -1,8 +1,5 @@--- Initial trurl.cabal generated by cabal init. For further documentation,--- see http://haskell.org/cabal/users-guide/- name: trurl-version: 0.1.0.0+version: 0.2.0.0 synopsis: Haskell template code generator -- description: homepage: http://github.com/dbushenko/trurl@@ -19,7 +16,7 @@ library exposed-modules: Trurl hs-source-dirs: src- build-depends: base >=4.7 && <4.8+ build-depends: base >= 4.7 && < 5 , http-conduit , directory , bytestring@@ -30,13 +27,14 @@ , scientific , unordered-containers , MissingH+ , filemanip default-language: Haskell2010 executable trurl main-is: src/Main.hs- build-depends: base >=4.7 && <4.8+ build-depends: base >= 4.7 && < 5 , trurl default-language: Haskell2010@@ -47,7 +45,7 @@ default-language: Haskell2010 type: exitcode-stdio-1.0 main-is: tests/Main.hs- build-depends: base >=4.7 && <4.8+ build-depends: base >= 4.7 && < 5 , hastache , tasty , tasty-hunit