trurl (empty) → 0.1.0.0
raw patch · 6 files changed
+295/−0 lines, 6 filesdep +MissingHdep +aesondep +basesetup-changed
Dependencies added: MissingH, aeson, base, bytestring, directory, hastache, http-conduit, scientific, tar, tasty, tasty-hunit, text, trurl, unordered-containers
Files
- LICENSE +30/−0
- Setup.hs +2/−0
- src/Main.hs +29/−0
- src/Trurl.hs +130/−0
- tests/Main.hs +49/−0
- trurl.cabal +55/−0
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright (c) 2015, dbushenko++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++ * Redistributions of source code must retain the above copyright+ notice, this list of conditions and the following disclaimer.++ * Redistributions in binary form must reproduce the above+ copyright notice, this list of conditions and the following+ disclaimer in the documentation and/or other materials provided+ with the distribution.++ * Neither the name of dbushenko nor the names of other+ contributors may be used to endorse or promote products derived+ from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ src/Main.hs view
@@ -0,0 +1,29 @@+{-# LANGUAGE OverloadedStrings #-}++module Main where++import Trurl+import System.Environment++help :: IO ()+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 " 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"
+ src/Trurl.hs view
@@ -0,0 +1,130 @@+{-# LANGUAGE OverloadedStrings #-}++module Trurl where++import GHC.Exts+import System.Directory+import Network.HTTP.Conduit+import Codec.Archive.Tar+import Data.List+import Text.Hastache +import Text.Hastache.Context+import Data.Aeson+import Data.Maybe+import Data.Scientific+import Data.String.Utils++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++mainRepoFile :: String+mainRepoFile = "mainRepo.tar"++mainRepo :: String+mainRepo = "https://github.com/dbushenko/trurl/raw/master/repository/" ++ mainRepoFile++getLocalRepoDir :: IO String+getLocalRepoDir = do+ home <- getHomeDirectory+ return $ home ++ "/.trurl/repo/"+ ++-- Команда "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 <project> <name>"+-- 1) Найти в $HOME/.trurl/repo архив с именем project.tar+-- 2) Создать дирректорию ./name+-- 3) Распаковать в ./name содержимое project.tar++createProject :: String -> String -> IO ()+createProject name project = do+ repoDir <- getLocalRepoDir+ createDirectoryIfMissing True name+ extract name $ repoDir ++ project ++ ".tar"++-- Команда "new <file> <parameters>"+-- 1) Найти в $HOME/.trurl/repo архив с именем file.hs.+-- Если имя файла передано с расширением, то найти точное имя файла, не подставляя *.hs+-- 2) Прочитать содержимое шаблона+-- 3) Отрендерить его с применением hastache и переденных параметров+-- 4) Записать файл в ./++getFileName :: String -> String+getFileName template =+ if "." `isInfixOf` template then template+ else template ++ ".hs"++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 (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)++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+ in mkVariable v++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++newTemplate :: String -> String -> String -> IO ()+newTemplate name templateName paramsStr = do+ repoDir <- getLocalRepoDir+ let templPath = getFullFileName repoDir templateName+ template <- T.readFile templPath+ 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++listTemplates :: IO ()+listTemplates = do+ repoDir <- getLocalRepoDir+ files <- getDirectoryContents repoDir+ let mpaths = filter (endswith ".metainfo") files+ mapM_ (printFileHeader repoDir) mpaths++helpTemplate :: String -> IO ()+helpTemplate template = do+ repoDir <- getLocalRepoDir+ printFile repoDir ((getFileName template) ++ ".metainfo")
+ tests/Main.hs view
@@ -0,0 +1,49 @@+{-# LANGUAGE OverloadedStrings #-}++module Main where++import Test.Tasty+import Test.Tasty.HUnit+import Text.Hastache +import Text.Hastache.Context++import qualified Trurl as T++main :: IO ()+main = defaultMain tests++tests :: TestTree+tests = testGroup "Tests" [unitTests]++unitTests :: TestTree+unitTests = testGroup "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 "mkContext empty" $ do+ generated <- hastacheStr defaultConfig "" (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"++ , testCase "mkContext complex object" $ do+ generated <- hastacheStr defaultConfig "{{a}}-{{b}}" (mkStrContext (T.mkContext "{\"a\":11,\"b\":\"abc\"}"))+ assertEqual "Checking generated text" generated "11-abc"++ , 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"++ , testCase "mkContext nested object" $ do+ generated <- hastacheStr defaultConfig "{{#abc}}{{name}}{{/abc}}" (mkStrContext (T.mkContext "{\"abc\":{\"name\":\"1\"}}"))+ assertEqual "Checking generated text" generated "1"++ ]
+ trurl.cabal view
@@ -0,0 +1,55 @@+-- Initial trurl.cabal generated by cabal init. For further documentation,+-- see http://haskell.org/cabal/users-guide/++name: trurl+version: 0.1.0.0+synopsis: Haskell template code generator+-- description: +homepage: http://github.com/dbushenko/trurl+license: BSD3+license-file: LICENSE+author: dbushenko+maintainer: d.bushenko@gmail.com+-- copyright: +category: Development+build-type: Simple+-- extra-source-files: +cabal-version: >=1.10++library+ exposed-modules: Trurl+ hs-source-dirs: src+ build-depends: base >=4.7 && <4.8+ , http-conduit+ , directory+ , bytestring+ , text+ , tar+ , hastache+ , aeson+ , scientific+ , unordered-containers+ , MissingH+ + default-language: Haskell2010+++executable trurl+ main-is: src/Main.hs+ build-depends: base >=4.7 && <4.8+ , trurl++ default-language: Haskell2010+++ +test-suite tests+ default-language: Haskell2010+ type: exitcode-stdio-1.0+ main-is: tests/Main.hs+ build-depends: base >=4.7 && <4.8+ , hastache+ , tasty+ , tasty-hunit+ , trurl+