module Trurl where
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.Aeson
import Data.Aeson
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.Lazy.IO as TL
import qualified Data.ByteString.Lazy as BL
import qualified Data.ByteString.Lazy.Char8 as BLC8
import Registry
constProjectName :: String
constProjectName = "ProjectName"
registryUrl :: String
registryUrl = "https://github.com/dbushenko/trurl/raw/master/repository/registry.json"
templateExt :: String
templateExt = ".template"
getLocalRepoDir :: IO FilePath
getLocalRepoDir = do
home <- getHomeDirectory
return $ home ++ "/.trurl/repo/"
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 $ headDef "No info found..." $ lines file
processTemplate :: String -> String -> FilePath -> IO ()
processTemplate projName paramsStr filePath = do
generated <- hastacheFile defaultConfig filePath (mkProjContext projName paramsStr)
TL.writeFile (dropExtension filePath) generated
removeFile filePath
return ()
getFullFileName :: FilePath -> String -> FilePath
getFullFileName repoDir template = repoDir ++ template
mkJsonContext :: Monad m => String -> MuContext m
mkJsonContext =
maybe mkEmptyContext jsonValueContext . decode . BLC8.pack
mkEmptyContext :: Monad m => MuContext m
mkEmptyContext = const $ return MuNothing
mkProjContext :: Monad m => String -> String -> MuContext m
mkProjContext projName paramsStr =
assoc "ProjectName" projName $ mkJsonContext paramsStr
mkFileContext :: Monad m => FilePath -> String -> MuContext m
mkFileContext fname paramsStr =
assoc "FileName" fname $ mkJsonContext paramsStr
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
downloadTemplate :: String -> Registry -> IO ()
downloadTemplate repoDir (Registry u tname) = do
let tFile = repoDir ++ tname
mname = tname ++ ".metainfo"
mFile = repoDir ++ mname
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
updateFromRepository :: IO ()
updateFromRepository = do
repoDir <- getLocalRepoDir
createDirectoryIfMissing True repoDir
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
createProject :: String -> String -> String -> IO ()
createProject name project paramsStr = do
repoDir <- getLocalRepoDir
createDirectoryIfMissing True name
extract name $ repoDir ++ project ++ ".tar"
templatePaths <- find always (extension ==? templateExt) name
mapM_ (processTemplate name paramsStr) templatePaths
let checkFileName fname templname = isInfixOf templname fname
projNamePaths <- find always (liftOp checkFileName fileName constProjectName) name
let renameProjNameFile fpath = renameFile fpath (substituteProjectName name fpath)
mapM_ renameProjNameFile projNamePaths
newTemplate :: String -> String -> String -> IO ()
newTemplate name tName paramsStr = do
repoDir <- getLocalRepoDir
let templPath = getFullFileName repoDir tName
generated <- hastacheFile defaultConfig templPath (mkFileContext name paramsStr)
TL.writeFile name generated
listTemplates :: IO ()
listTemplates = do
repoDir <- getLocalRepoDir
files <- getDirectoryContents repoDir
let mpaths = filter (endswith ".metainfo") $ sort files
mapM_ (printFileHeader repoDir) mpaths
helpTemplate :: String -> IO ()
helpTemplate template = do
repoDir <- getLocalRepoDir
templExists <- doesFileExist $ repoDir ++ template ++ ".metainfo"
if templExists then printFile repoDir $ template ++ ".metainfo"
else printFile repoDir (template ++ ".tar.metainfo")