{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE OverloadedStrings #-}
module ProjectForge.Get (
getProjectTemplateFromDir
, getProjectTemplateFromGit
, getFileTemplateFromFile
, directoryListToTemplate
) where
import Blammo.Logging.Simple
import Control.Exception
import Control.Monad
import Control.Monad.IO.Class
import qualified Data.ByteString as BL
import Data.Maybe (fromMaybe)
import Data.Text
import Data.Text.Encoding
import GHC.Generics
import ProjectForge.Compile
import ProjectForge.Get.Git
import ProjectForge.ProjectTemplate
import System.Directory
import System.FilePath
import System.IO.Temp
import System.Process.Typed
data GetProjectTemplateError =
NotADirectory
| FileNotFound
| NotAMustacheFile
| DecodeError
deriving (Int -> GetProjectTemplateError -> ShowS
[GetProjectTemplateError] -> ShowS
GetProjectTemplateError -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetProjectTemplateError] -> ShowS
$cshowList :: [GetProjectTemplateError] -> ShowS
show :: GetProjectTemplateError -> String
$cshow :: GetProjectTemplateError -> String
showsPrec :: Int -> GetProjectTemplateError -> ShowS
$cshowsPrec :: Int -> GetProjectTemplateError -> ShowS
Show, forall x. Rep GetProjectTemplateError x -> GetProjectTemplateError
forall x. GetProjectTemplateError -> Rep GetProjectTemplateError x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GetProjectTemplateError x -> GetProjectTemplateError
$cfrom :: forall x. GetProjectTemplateError -> Rep GetProjectTemplateError x
Generic)
instance Exception GetProjectTemplateError
directoryListToTemplate :: (MonadIO m) =>
[(FilePath, BL.ByteString)]
-> m ProjectTemplate
directoryListToTemplate :: forall (m :: * -> *).
MonadIO m =>
[(String, ByteString)] -> m ProjectTemplate
directoryListToTemplate [(String, ByteString)]
x =
forall (m :: * -> *).
MonadIO m =>
[(String, Text)] -> m ProjectTemplate
compileProjectTemplate forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse forall (m :: * -> *). MonadIO m => ByteString -> m Text
decodeToText) [(String, ByteString)]
x
decodeToText :: MonadIO m => BL.ByteString -> m Text
decodeToText :: forall (m :: * -> *). MonadIO m => ByteString -> m Text
decodeToText ByteString
x = case ByteString -> Either UnicodeException Text
decodeUtf8' ByteString
x of
Left UnicodeException
e -> forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall e a. Exception e => e -> IO a
throwIO UnicodeException
e
Right Text
v -> forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
v
getFileTemplateFromFile :: (MonadLogger m, MonadIO m) =>
FilePath
-> m FileTemplate
getFileTemplateFromFile :: forall (m :: * -> *).
(MonadLogger m, MonadIO m) =>
String -> m FileTemplate
getFileTemplateFromFile String
f = do
Bool
fileExists <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ String -> IO Bool
doesFileExist String
f
if Bool
fileExists then do
forall (m :: * -> *).
(HasCallStack, MonadLogger m) =>
Message -> m ()
logDebug forall a b. (a -> b) -> a -> b
$ Text
"Getting template from" Text -> [SeriesElem] -> Message
:# [ Key
"path" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= String
f ]
Text
contents <- forall (m :: * -> *). MonadIO m => ByteString -> m Text
decodeToText forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (String -> IO ByteString
BL.readFile String
f)
forall (m :: * -> *). MonadIO m => (String, Text) -> m FileTemplate
compileFileTemplate (String
f, Text
contents)
else do
forall (m :: * -> *).
(HasCallStack, MonadLogger m) =>
Message -> m ()
logError forall a b. (a -> b) -> a -> b
$ Text
"File not found" Text -> [SeriesElem] -> Message
:# [ Key
"path" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= String
f ]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall e a. Exception e => e -> IO a
throwIO GetProjectTemplateError
FileNotFound
getProjectTemplateFromDir :: (MonadLogger m, MonadIO m) =>
FilePath
-> m ProjectTemplate
getProjectTemplateFromDir :: forall (m :: * -> *).
(MonadLogger m, MonadIO m) =>
String -> m ProjectTemplate
getProjectTemplateFromDir String
d = do
Bool
dirExists <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ String -> IO Bool
doesDirectoryExist String
d
if Bool
dirExists then do
forall (m :: * -> *).
(HasCallStack, MonadLogger m) =>
Message -> m ()
logDebug forall a b. (a -> b) -> a -> b
$ Text
"Getting template from" Text -> [SeriesElem] -> Message
:# [ Key
"path" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= String
d ]
forall (m :: * -> *).
MonadIO m =>
String -> m [(String, ByteString)]
listRecursiveDirectoryFiles String
d forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (m :: * -> *).
MonadIO m =>
[(String, ByteString)] -> m ProjectTemplate
directoryListToTemplate
else do
forall (m :: * -> *).
(HasCallStack, MonadLogger m) =>
Message -> m ()
logError forall a b. (a -> b) -> a -> b
$ Text
"Directory not found" Text -> [SeriesElem] -> Message
:# [ Key
"path" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= String
d ]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall e a. Exception e => e -> IO a
throwIO GetProjectTemplateError
NotADirectory
getProjectTemplateFromGit :: (MonadLogger m, MonadIO m) =>
Maybe FilePath
-> GitURL
-> Maybe Branch
-> m ProjectTemplate
getProjectTemplateFromGit :: forall (m :: * -> *).
(MonadLogger m, MonadIO m) =>
Maybe String -> String -> Maybe String -> m ProjectTemplate
getProjectTemplateFromGit Maybe String
baseDir String
repository Maybe String
branch = do
String
tmpDir <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ String -> String -> IO String
createTempDirectory (forall a. a -> Maybe a -> a
fromMaybe String
"" Maybe String
baseDir) String
"dir"
forall (m :: * -> *).
(HasCallStack, MonadLogger m) =>
Message -> m ()
logDebug forall a b. (a -> b) -> a -> b
$ Text
"Created temporary directory for cloning" Text -> [SeriesElem] -> Message
:# [ Key
"path" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= String
tmpDir ]
let cloneArgs :: GitCloneArgs
cloneArgs = MkGitCloneArgs {
repository :: String
repository = String
repository
, directory :: String
directory = String
tmpDir
, branch :: Maybe String
branch = Maybe String
branch
, depth :: Maybe Integer
depth = forall a. a -> Maybe a
Just Integer
1
}
forall (m :: * -> *).
(HasCallStack, MonadLogger m) =>
Message -> m ()
logDebug forall a b. (a -> b) -> a -> b
$ Text
"Beginning git clone into" Text -> [SeriesElem] -> Message
:# [ Key
"path" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= String
tmpDir ]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) stdin stdout stderr.
MonadIO m =>
ProcessConfig stdin stdout stderr -> m ()
runProcess_ (GitCloneArgs -> ProcessConfig () () ()
gitClone GitCloneArgs
cloneArgs)
forall (m :: * -> *).
(HasCallStack, MonadLogger m) =>
Message -> m ()
logDebug forall a b. (a -> b) -> a -> b
$ Text
"Removing .git directory" Text -> [SeriesElem] -> Message
:# [ Key
"path" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= String
tmpDir ]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ String -> IO ()
removeDirectoryRecursive (String
tmpDir String -> ShowS
</> String
".git")
forall (m :: * -> *).
(HasCallStack, MonadLogger m) =>
Message -> m ()
logDebug Message
"Getting Project template from cloned directory"
!ProjectTemplate
template <- forall (m :: * -> *).
(MonadLogger m, MonadIO m) =>
String -> m ProjectTemplate
getProjectTemplateFromDir String
tmpDir
forall (m :: * -> *).
(HasCallStack, MonadLogger m) =>
Message -> m ()
logDebug forall a b. (a -> b) -> a -> b
$ Text
"Removing cloned directory" Text -> [SeriesElem] -> Message
:# [ Key
"path" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= String
tmpDir ]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ String -> IO ()
removeDirectoryRecursive String
tmpDir
forall (f :: * -> *) a. Applicative f => a -> f a
pure ProjectTemplate
template
listRecursiveDirectoryFiles :: MonadIO m => FilePath -> m [(FilePath, BL.ByteString)]
listRecursiveDirectoryFiles :: forall (m :: * -> *).
MonadIO m =>
String -> m [(String, ByteString)]
listRecursiveDirectoryFiles = forall (m :: * -> *).
MonadIO m =>
(String -> m [(String, ByteString)])
-> String -> m [(String, ByteString)]
listDirectoryFilesF forall (m :: * -> *).
MonadIO m =>
String -> m [(String, ByteString)]
listRecursiveDirectoryFiles
listDirectoryFilesF :: MonadIO m =>
(FilePath -> m [(FilePath, BL.ByteString)])
-> FilePath -> m [(FilePath, BL.ByteString)]
listDirectoryFilesF :: forall (m :: * -> *).
MonadIO m =>
(String -> m [(String, ByteString)])
-> String -> m [(String, ByteString)]
listDirectoryFilesF String -> m [(String, ByteString)]
go String
topdir = do
[String]
names <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ String -> IO [String]
getDirectoryContents String
topdir
let properNames :: [String]
properNames = forall a. (a -> Bool) -> [a] -> [a]
Prelude.filter (forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [String
".", String
".."]) [String]
names
[[(String, ByteString)]]
paths <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [String]
properNames forall a b. (a -> b) -> a -> b
$ \String
name -> do
let path :: String
path = String
topdir String -> ShowS
</> String
name
Bool
isDirectory <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ String -> IO Bool
doesDirectoryExist String
path
if Bool
isDirectory
then String -> m [(String, ByteString)]
go String
path
else do
ByteString
contents <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ String -> IO ByteString
BL.readFile String
path
forall (f :: * -> *) a. Applicative f => a -> f a
pure [(String
path, ByteString
contents)]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall (t :: * -> *) a. Foldable t => t [a] -> [a]
Prelude.concat [[(String, ByteString)]]
paths)