{-# 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)
getTemplateName :: Template -> String
getTemplateName :: Template -> String
getTemplateName (Template String
name String
_) = String
name
getTemplatePath :: Template -> FilePath
getTemplatePath :: Template -> String
getTemplatePath (Template String
_ String
path) = String
path
getTemplatePathByName :: [Template] -> String -> FilePath
getTemplatePathByName :: [Template] -> String -> String
getTemplatePathByName [] [] = String
""
getTemplatePathByName [] String
_ = String
""
getTemplatePathByName (Template
x:[Template]
xs) String
name =
if String
templateName String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
name then
String
templatePath
else
[Template] -> String -> String
getTemplatePathByName [Template]
xs String
name
where
templateName :: String
templateName = Template -> String
getTemplateName Template
x
templatePath :: String
templatePath = Template -> String
getTemplatePath Template
x
projectDataFile :: String
projectDataFile :: String
projectDataFile = String
"project.yml"
ignoreFiles :: [FilePath]
ignoreFiles :: [String]
ignoreFiles = [String
".gitignore", String
"svnignore.txt"]
knownIgnoredFiles :: [Pattern]
knownIgnoredFiles :: [Pattern]
knownIgnoredFiles = [String] -> [Pattern]
globbifyList [String
".git", String
".svn", String
projectDataFile]
hasPathQuestionnaire :: FilePath -> IO Bool
hasPathQuestionnaire :: String -> IO Bool
hasPathQuestionnaire = String -> IO Bool
doesFileExist (String -> IO Bool) -> (String -> String) -> String -> IO Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
questionnaireFileByPath
questionnaireFileByPath :: FilePath -> FilePath
questionnaireFileByPath :: String -> String
questionnaireFileByPath String
path = [String] -> String
joinPath [String
path, String
projectDataFile]
createFilesFromTemplate :: FilePath -> [(Text, Value)] -> IO ()
createFilesFromTemplate :: String -> [(Text, Value)] -> IO ()
createFilesFromTemplate String
root = [Pattern] -> String -> String -> [(Text, Value)] -> IO ()
walk [Pattern]
knownIgnoredFiles String
root String
""
walk :: [Pattern] -> FilePath -> FilePath -> [(Text, Value)] -> IO ()
walk :: [Pattern] -> String -> String -> [(Text, Value)] -> IO ()
walk [Pattern]
currentBlacklist String
templateRoot String
currentPath [(Text, Value)]
responses =
String -> Callback IO WalkStatus -> IO ()
forall (m :: * -> *).
MonadIO m =>
String -> Callback m WalkStatus -> m ()
pathWalkInterruptible String
absolutePath (Callback IO WalkStatus -> IO ())
-> Callback IO WalkStatus -> IO ()
forall a b. (a -> b) -> a -> b
$ \String
_ [String]
dirs [String]
files -> do
[Pattern]
blacklist <- IO [Pattern]
getBlacklist
String
-> String -> [String] -> [Pattern] -> [(Text, Value)] -> IO ()
render String
templateRoot String
relativePath [String]
files [Pattern]
blacklist [(Text, Value)]
responses
(String -> IO ()) -> [String] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (\String
f ->
[Pattern] -> String -> String -> [(Text, Value)] -> IO ()
walk [Pattern]
blacklist String
templateRoot ([String] -> String
joinPath [String
relativePath, String
f]) [(Text, Value)]
responses
)
([String] -> [Pattern] -> [String]
whitelist [String]
dirs [Pattern]
blacklist)
WalkStatus -> IO WalkStatus
forall (m :: * -> *) a. Monad m => a -> m a
return WalkStatus
StopRecursing
where
absolutePath :: String
absolutePath = [String] -> String
joinPath [String
templateRoot, String
currentPath]
relativePath :: String
relativePath = String -> String -> String
makeRelative String
templateRoot String
currentPath
getBlacklist :: IO [Pattern]
getBlacklist = do
[Pattern]
newBlacklist <- String -> IO [Pattern]
populateBlacklist String
absolutePath
[Pattern] -> IO [Pattern]
forall (m :: * -> *) a. Monad m => a -> m a
return ([Pattern] -> IO [Pattern]) -> [Pattern] -> IO [Pattern]
forall a b. (a -> b) -> a -> b
$ [Pattern]
currentBlacklist [Pattern] -> [Pattern] -> [Pattern]
forall a. [a] -> [a] -> [a]
++ [Pattern]
newBlacklist
whitelist :: [String] -> [Pattern] -> [String]
whitelist [String]
dirs [Pattern]
blacklist = [
String
f | String
f <- [String]
dirs,
Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ String -> [Pattern] -> Bool
isInBlacklist String
f [Pattern]
blacklist
]
populateBlacklist :: FilePath -> IO [Pattern]
populateBlacklist :: String -> IO [Pattern]
populateBlacklist String
root = [String] -> IO [Pattern]
getIgnoredPatterns ((String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (\String
f -> [String] -> String
joinPath [String
root, String
f]) [String]
ignoreFiles)
render :: FilePath -> FilePath -> [FilePath] -> [Pattern] -> [(Text, Value)] -> IO()
render :: String
-> String -> [String] -> [Pattern] -> [(Text, Value)] -> IO ()
render String
templateRoot String
path [String]
files [Pattern]
blacklist [(Text, Value)]
responses = do
Bool -> String -> IO ()
createDirectoryIfMissing Bool
True String
path
[String] -> (String -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [String]
files ((String -> IO ()) -> IO ()) -> (String -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \String
file ->
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (String -> [Pattern] -> Bool
isInBlacklist String
file [Pattern]
blacklist) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
let fileAbsolutePath :: String
fileAbsolutePath = [String] -> String
joinPath [String
templateRoot, String
path, String
file]
fileRelativePath :: String
fileRelativePath = [String] -> String
joinPath [String
path, String
file]
String -> IO ()
success (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> String
fileCreated String
fileRelativePath
Either String Template
template <- String -> IO (Either String Template)
eitherParseFile String
fileAbsolutePath
case Either String Template
template of
Right Template
t ->
case Template -> Object -> Either String Text
eitherRender Template
t Object
templateData of
Right Text
res -> String -> ByteString -> IO ()
BS.writeFile String
fileRelativePath (Text -> ByteString
encodeUtf8 Text
res)
Left String
e -> String -> String -> String -> IO ()
fallback String
e String
fileAbsolutePath String
fileRelativePath
Left String
e -> String -> String -> String -> IO ()
fallback String
e String
fileAbsolutePath String
fileRelativePath
where
templateData :: Object
templateData = [(Text, Value)] -> Object
fromPairs [(Text, Value)]
responses
fallback :: String -> String -> String -> IO ()
fallback String
e String
inPath String
outPath = do
String -> IO ()
warning String
parserError
String -> IO ()
putStrLn String
e
ByteString
file <- String -> IO ByteString
BS.readFile String
inPath
String -> ByteString -> IO ()
BS.writeFile String
outPath ByteString
file
isInBlacklist :: FilePath -> [Pattern] -> Bool
isInBlacklist :: String -> [Pattern] -> Bool
isInBlacklist String
path = (Pattern -> Bool) -> [Pattern] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Pattern -> String -> Bool
`match` String
path)
getIgnoredPatterns :: [FilePath] -> IO [Pattern]
getIgnoredPatterns :: [String] -> IO [Pattern]
getIgnoredPatterns [String]
files = do
[[Pattern]]
res <- (String -> IO [Pattern]) -> [String] -> IO [[Pattern]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM String -> IO [Pattern]
findIgnoredFilesList [String]
files
[Pattern] -> IO [Pattern]
forall (m :: * -> *) a. Monad m => a -> m a
return ([Pattern] -> IO [Pattern]) -> [Pattern] -> IO [Pattern]
forall a b. (a -> b) -> a -> b
$ [Pattern] -> [Pattern]
forall a. Eq a => [a] -> [a]
nub ([Pattern] -> [Pattern]) -> [Pattern] -> [Pattern]
forall a b. (a -> b) -> a -> b
$ [Pattern] -> [[Pattern]] -> [Pattern]
forall a. [a] -> [[a]] -> [a]
intercalate [] [[Pattern]]
res
findIgnoredFilesList :: FilePath -> IO [Pattern]
findIgnoredFilesList :: String -> IO [Pattern]
findIgnoredFilesList String
f = do
Bool
hasFile <- String -> IO Bool
doesFileExist String
f
if Bool
hasFile then do
String
file <- String -> IO String
readFile String
f
[Pattern] -> IO [Pattern]
forall (m :: * -> *) a. Monad m => a -> m a
return ([Pattern] -> IO [Pattern]) -> [Pattern] -> IO [Pattern]
forall a b. (a -> b) -> a -> b
$ (
[String] -> [Pattern]
globbifyList ([String] -> [Pattern])
-> ([String] -> [String]) -> [String] -> [Pattern]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
[String] -> [String]
extendIgnoredFiles ([String] -> [String])
-> ([String] -> [String]) -> [String] -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
[String] -> [String]
removeSeparatorPrefix ([String] -> [String])
-> ([String] -> [String]) -> [String] -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
[String] -> [String]
cleanList
) ([String] -> [Pattern]) -> [String] -> [Pattern]
forall a b. (a -> b) -> a -> b
$ String -> [String]
lines String
file
else [Pattern] -> IO [Pattern]
forall (m :: * -> *) a. Monad m => a -> m a
return []
where
cleanList :: [String] -> [String]
cleanList [String]
list = (\String
l -> (Bool -> Bool
not (Bool -> Bool) -> (String -> Bool) -> String -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null) String
l Bool -> Bool -> Bool
&& String -> Char
forall a. [a] -> a
head String
l Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'#') (String -> Bool) -> [String] -> [String]
forall a. (a -> Bool) -> [a] -> [a]
`filter` [String]
list
removeSeparatorPrefix :: [FilePath] -> [FilePath]
removeSeparatorPrefix :: [String] -> [String]
removeSeparatorPrefix = (String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map ((String -> String) -> [String] -> [String])
-> (String -> String) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$ \String
p -> if String -> Char
forall a. [a] -> a
head String
p Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
pathSeparator then String -> String
forall a. [a] -> [a]
tail String
p else String
p
extendIgnoredFiles :: [FilePath] -> [FilePath]
extendIgnoredFiles :: [String] -> [String]
extendIgnoredFiles (String
x:[String]
xs) =
if (Bool -> Bool
not (Bool -> Bool) -> (String -> Bool) -> String -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null) String
extension then
String
x String -> [String] -> [String]
forall a. a -> [a] -> [a]
: String
extension String -> [String] -> [String]
forall a. a -> [a] -> [a]
: [String] -> [String]
extendIgnoredFiles [String]
xs
else String
x String -> [String] -> [String]
forall a. a -> [a] -> [a]
: [String] -> [String]
extendIgnoredFiles [String]
xs
where
extension :: String
extension = if ((String -> Bool) -> Bool) -> [String -> Bool] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (\String -> Bool
t -> String -> Bool
t String
dirName) [String -> Bool]
tests then String
dirName else []
dirName :: String
dirName = (String -> String
takeDirectory (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
normalise) String
x
tests :: [String -> Bool]
tests = [
String -> Bool
isValid,
Bool -> Bool
not (Bool -> Bool) -> (String -> Bool) -> String -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Bool
isDrive,
Bool -> Bool
not (Bool -> Bool) -> (String -> Bool) -> String -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Bool
isDot,
Bool -> Bool
not (Bool -> Bool) -> (String -> Bool) -> String -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Bool
isWildCard,
Bool -> Bool
not (Bool -> Bool) -> (String -> Bool) -> String -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Bool
isDoubleWildCard
]
extendIgnoredFiles [] = []
isDot :: FilePath -> Bool
isDot :: String -> Bool
isDot = String -> String -> Bool
forall a. Eq a => a -> a -> Bool
(==) String
"."
isWildCard :: FilePath -> Bool
isWildCard :: String -> Bool
isWildCard = String -> String -> Bool
forall a. Eq a => a -> a -> Bool
(==) String
"*"
isDoubleWildCard :: FilePath -> Bool
isDoubleWildCard :: String -> Bool
isDoubleWildCard = String -> String -> Bool
forall a. Eq a => a -> a -> Bool
(==) String
"**"
globbifyList :: [FilePath] -> [Pattern]
globbifyList :: [String] -> [Pattern]
globbifyList = (String -> Pattern) -> [String] -> [Pattern]
forall a b. (a -> b) -> [a] -> [b]
map (Pattern -> Pattern
simplify (Pattern -> Pattern) -> (String -> Pattern) -> String -> Pattern
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Pattern
compile)