{-|
Functions for marshalling Project and File Templates into a program.
-}
{-# LANGUAGE BangPatterns      #-}
{-# LANGUAGE DeriveGeneric     #-}
{-# LANGUAGE OverloadedStrings #-}
module ProjectForge.Get (
  -- * Get Templates
  -- $getTemplates
    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

{- $getTemplates

Utilities for converting a directory into a @'ProjectTemplate'@.

-}

{-|
Ways in which getting a project template may go badly.
-}
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

{-|
Converts a list of @FilePath@ and @ByteString@ pairs to a @'ProjectTemplate'@.

The @ByteString@ are decoded into @'Data.Text.Text'@ by
@'Data.Text.Encoding.decodeUtf8'@.
If decoding results in a @Data.Text.Encoding.Error.UnicodeException@
for any value,
then this is thrown as an exception.
-}
directoryListToTemplate :: (MonadIO m) =>
  -- | list of (@FilePath@, @ByteString@) pairs
  -- corresponding to the contents of a template directory
    [(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

-- Internal utilitie for converting a bytestring to text.
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

{-|
Convert a file to a @'FileTemplate'@.
A @GetProjectTemplateError@ exception is thrown if the input file
does not exist.

>>> runSimpleLoggingT $ getFileTemplateFromFile "foo.txt"
FileNotFound

-}
getFileTemplateFromFile :: (MonadLogger m, MonadIO m) =>
    FilePath -- ^ name of the file
  -> 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


{-|
Convert a directory to a @'ProjectTemplate'@.
A @GetProjectTemplateError@ exception is thrown if the input directory
does not exist.

>>> runSimpleLoggingT $ getProjectTemplateFromDir "foo"
NotADirectory

-}
getProjectTemplateFromDir :: (MonadLogger m, MonadIO m) =>
    FilePath -- ^ name of the directory containing template files
  -> 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

{-|
Convert a git repository to a @ProjectTemplate@.

This action creates a shallow clone of the repo in a temporary directory
before calling @'getProjectTemplateFromDir'@ on the temporary directory.
The temporary directory is removed when complete.

This function __requires that__
__[`git` be installed](https://git-scm.com/book/en/v2/Getting-Started-Installing-Git)__.
-}
getProjectTemplateFromGit :: (MonadLogger m, MonadIO m) =>
   -- | Optional parent directory in which to clone the repo in.
   --   Defaults to current directory.
      Maybe FilePath
   -- | The [Git URL](https://www.git-scm.com/docs/git-clone#_git_urls)
   --   of the template directory.
   -> GitURL
   -- | Optional name of git branch.
   --   If @Nothing@, uses default git branch.
   -> 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

{-
The following are basically lifted from:
https://hackage.haskell.org/package/file-embed-lzma-0.0.1/docs/src/FileEmbedLzma.html#listRecursiveDirectoryFiles
-}

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)]) -- ^ what to do with a sub-directory
    -> 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)