Project.hs

{-# LANGUAGE OverloadedStrings #-}

module Rob.Project where

import Rob.Types (Template(..))
import Rob.Logger (warning, success)
import Rob.UserMessages (parserError, fileCreated)

import Data.Yaml (Value)
import Control.Monad (forM_, unless)
import Data.Text (Text)
import qualified Data.ByteString.Lazy as BS
import Data.Text.Lazy.Encoding (encodeUtf8)
import System.FilePath.Posix (makeRelative)
import Data.List (any, nub, intercalate)
import System.FilePath.Glob (match, simplify, compile, Pattern)
import Text.EDE (eitherRender, eitherParseFile, fromPairs)
import System.Directory.PathWalk (pathWalkInterruptible, WalkStatus(..))
import System.Directory (doesFileExist, createDirectoryIfMissing)
import System.FilePath (joinPath, takeDirectory, normalise, isDrive, isValid, pathSeparator)

-- | Get only the template name
getTemplateName :: Template -> String
getTemplateName (Template name _) = name

-- | Get only the template path
getTemplatePath :: Template -> FilePath
getTemplatePath (Template _ path) = path

-- | Get the template name by its path
getTemplatePathByName :: [Template] -> String -> FilePath
getTemplatePathByName [] [] = ""
getTemplatePathByName [] _ = ""
getTemplatePathByName (x:xs) name =
  if templateName == name then
    templatePath
  else
    getTemplatePathByName xs name
  where
    templateName = getTemplateName x
    templatePath = getTemplatePath x

-- | File where users can store all the project creation questions
projectDataFile :: String
projectDataFile = "project.yml"

ignoreFiles :: [FilePath]
ignoreFiles = [".gitignore", "svnignore.txt"]

knownIgnoredFiles :: [Pattern]
knownIgnoredFiles = globbifyList [".git", ".svn", projectDataFile]

-- | Check if the path contains the questionnaire file
hasPathQuestionnaire :: FilePath -> IO Bool
hasPathQuestionnaire = doesFileExist . questionnaireFileByPath

-- | Get the questionnaire file by project path
questionnaireFileByPath :: FilePath -> FilePath
questionnaireFileByPath path = joinPath [path, projectDataFile]

-- | Start the template creation
createFilesFromTemplate :: FilePath -> [(Text, Value)] -> IO ()
createFilesFromTemplate root = walk knownIgnoredFiles root ""

-- | Walk recursively a folder copying its files using
walk :: [Pattern] -> FilePath -> FilePath -> [(Text, Value)] -> IO ()
walk currentBlacklist templateRoot currentPath responses =
  pathWalkInterruptible absolutePath $ \_ dirs files -> do
    blacklist <- getBlacklist
    render templateRoot relativePath files blacklist responses
    mapM_ (\f ->
        walk blacklist templateRoot (joinPath [relativePath, f]) responses
      )
      (whitelist dirs blacklist)
    return StopRecursing
    where
      absolutePath = joinPath [templateRoot, currentPath]
      relativePath = makeRelative templateRoot currentPath
      getBlacklist = do
        newBlacklist <- populateBlacklist absolutePath
        return $ currentBlacklist ++ newBlacklist
      whitelist dirs blacklist = [
          f | f <- dirs,
          not $ isInBlacklist f blacklist
        ]

-- | Add eventually new ignored files to the blacklist map
populateBlacklist :: FilePath -> IO [Pattern]
populateBlacklist root = getIgnoredPatterns (map (\f -> joinPath [root, f]) ignoreFiles)

-- | Parse a directory copying the files found into the current one
-- | where rob was called, it will also render eventually the answers to the questionnaire
-- | if template token will be found in any of the files
render :: FilePath -> FilePath -> [FilePath] -> [Pattern] -> [(Text, Value)] -> IO()
render templateRoot path files blacklist responses = do
  createDirectoryIfMissing True path
  forM_ files $ \file ->
    unless (isInBlacklist file blacklist) $ do
      let fileAbsolutePath = joinPath [templateRoot, path, file]
          fileRelativePath = joinPath [path, file]
      success $ fileCreated fileRelativePath
      template <- eitherParseFile fileAbsolutePath
      case template of
        Right t ->
          case eitherRender t templateData of
            Right res -> BS.writeFile fileRelativePath (encodeUtf8 res)
            Left e -> fallback e fileAbsolutePath fileRelativePath
        Left e -> fallback e fileAbsolutePath fileRelativePath
  where
    templateData = fromPairs responses
    fallback e inPath outPath = do
      warning parserError
      putStrLn e
      file <- BS.readFile inPath
      BS.writeFile outPath file

-- | Check whether a path is blacklisted looking it up in the blacklist map
-- | here basically we try to emulate the gitignore behavior recursively
isInBlacklist :: FilePath -> [Pattern] -> Bool
isInBlacklist path = any (`match` path)

-- | Get all the files to ignore uniquelly from a list of known .ignore files
getIgnoredPatterns :: [FilePath] -> IO [Pattern]
getIgnoredPatterns files = do
  res <- mapM findIgnoredFilesList files
  return $ nub $ intercalate [] res

-- | Figure out which files must be ignored reading them from the .gitignore
findIgnoredFilesList :: FilePath -> IO [Pattern]
findIgnoredFilesList f = do
  hasFile <- doesFileExist f
  if hasFile then do
    file <- readFile f
    return $ (
        globbifyList .
        extendIgnoredFiles .
        removeSeparatorPrefix .
        cleanList
      ) $ lines file
  else return []
  where
    cleanList list = (\l -> (not . null) l && head l /= '#') `filter` list

-- | Remove the initial separator prefix
removeSeparatorPrefix :: [FilePath] -> [FilePath]
removeSeparatorPrefix = map $ \p -> if head p == pathSeparator then tail p else p


-- | Extend the ignored files in order to enhance the patterns matching
-- | for example with the "/node_modules/*" pattern we will add also "/node_modules"
-- | to the excluded folders
extendIgnoredFiles :: [FilePath] -> [FilePath]
extendIgnoredFiles (x:xs) =
    if (not . null) extension then
      x : extension : extendIgnoredFiles xs
    else x : extendIgnoredFiles xs
  where
    extension = if all (\t -> t dirName) tests then dirName else []
    dirName   = (takeDirectory . normalise) x
    tests = [
        isValid,
        not . isDrive,
        not . isDot,
        not . isWildCard,
        not . isDoubleWildCard
      ]
extendIgnoredFiles [] = []

-- | Helpers to enhance the ignored files
isDot :: FilePath -> Bool
isDot = (==) "."

isWildCard :: FilePath -> Bool
isWildCard = (==) "*"

isDoubleWildCard :: FilePath -> Bool
isDoubleWildCard = (==) "**"

-- | Map a list of file paths to glob patterns
globbifyList :: [FilePath] -> [Pattern]
globbifyList = map (simplify . compile)