<commit_before>{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TemplateHaskell #-}

-- | Create new a new project directory populated with a basic working
-- project.

module Stack.New
    ( new
    , NewOpts(..)
    , defaultTemplateName
    , templateNameArgument
    , getTemplates
    , TemplateName
    , listTemplates)
    where

import           Control.Monad
import           Control.Monad.Catch
import           Control.Monad.IO.Class
import           Control.Monad.Logger
import           Control.Monad.Reader
import           Control.Monad.Trans.Writer.Strict
import           Data.Aeson
import           Data.Aeson.Types
import qualified Data.ByteString.Lazy as LB
import qualified Data.ByteString.Lazy.Char8 as L8
import           Data.Conduit
import           Data.List
import           Data.Map.Strict (Map)
import qualified Data.Map.Strict as M
import           Data.Maybe.Extra (mapMaybeM)
import           Data.Monoid
import           Data.Set (Set)
import qualified Data.Set as S
import           Data.Text (Text)
import qualified Data.Text as T
import qualified Data.Text.Encoding as T
import qualified Data.Text.IO as T
import qualified Data.Text.Lazy as LT
import           Data.Typeable
import           Network.HTTP.Client.Conduit hiding (path)
import           Network.HTTP.Download
import           Network.HTTP.Types.Status
import           Path
import           Path.IO
import           Stack.Constants
import           Stack.Types
import           Stack.Types.TemplateName
import           System.Process.Run
import           Text.Hastache
import           Text.Hastache.Context
import           Text.ProjectTemplate

--------------------------------------------------------------------------------
-- Main project creation

-- | Options for creating a new project.
data NewOpts = NewOpts
    { newOptsProjectName  :: PackageName
    -- ^ Name of the project to create.
    , newOptsCreateBare   :: Bool
    -- ^ Whether to create the project without a directory.
    , newOptsTemplate     :: TemplateName
    -- ^ Name of the template to use.
    , newOptsNonceParams  :: Map Text Text
    -- ^ Nonce parameters specified just for this invocation.
    }

-- | Create a new project with the given options.
new
    :: (HasConfig r, MonadReader r m, MonadLogger m, MonadCatch m, MonadThrow m, MonadIO m, HasHttpManager r)
    => NewOpts -> m (Path Abs Dir)
new opts = do
    pwd <- getWorkingDir
    absDir <- if bare then return pwd
                      else do relDir <- parseRelDir (packageNameString project)
                              liftM (pwd </>) (return relDir)
    exists <- dirExists absDir
    if exists && not bare
        then throwM (AlreadyExists absDir)
        else do
            logUsing absDir
            templateText <- loadTemplate template
            files <-
                applyTemplate
                    project
                    template
                    (newOptsNonceParams opts)
                    absDir
                    templateText
            writeTemplateFiles files
            runTemplateInits absDir
            return absDir
  where
    template = newOptsTemplate opts
    project = newOptsProjectName opts
    bare = newOptsCreateBare opts
    logUsing absDir =
        $logInfo
            ("Downloading template \"" <> templateName template <>
             "\" to create project \"" <>
             packageNameText project <>
             "\" in " <>
             if bare then "the current directory"
                     else T.pack (toFilePath (dirname absDir)) <>
             " ...")

-- | Download and read in a template's text content.
loadTemplate
    :: forall m r.
       (HasConfig r, HasHttpManager r, MonadReader r m, MonadIO m, MonadThrow m, MonadCatch m)
    => TemplateName -> m Text
loadTemplate name =
    case templatePath name of
        Left absFile -> loadLocalFile absFile
        Right relFile ->
            catch
                (loadLocalFile relFile)
                (\(_ :: NewException) ->
                      downloadTemplate relFile)
  where
    loadLocalFile :: Path b File -> m Text
    loadLocalFile path = do
        exists <- fileExists path
        if exists
            then liftIO (T.readFile (toFilePath path))
            else throwM (FailedToLoadTemplate name (toFilePath path))
    downloadTemplate :: Path Rel File -> m Text
    downloadTemplate rel = do
        config <- asks getConfig
        req <- parseUrl (defaultTemplateUrl <> "/" <> toFilePath rel)
        let path :: Path Abs File
            path = templatesDir config </> rel
        _ <-
            catch
                (redownload req path)
                (throwM . FailedToDownloadTemplate name)
        exists <- fileExists path
        if exists
            then liftIO (T.readFile (toFilePath path))
            else throwM (FailedToLoadTemplate name (toFilePath path))

-- | Apply and unpack a template into a directory.
applyTemplate
    :: (MonadIO m, MonadThrow m, MonadReader r m, HasConfig r, MonadLogger m)
    => PackageName
    -> TemplateName
    -> Map Text Text
    -> Path Abs Dir
    -> Text<commit_msg>reuse factored out code to avoid repitition<commit_after>{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TemplateHaskell #-}

-- | Create new a new project directory populated with a basic working
-- project.

module Stack.New
    ( new
    , NewOpts(..)
    , defaultTemplateName
    , templateNameArgument
    , getTemplates
    , TemplateName
    , listTemplates)
    where

import           Control.Monad
import           Control.Monad.Catch
import           Control.Monad.IO.Class
import           Control.Monad.Logger
import           Control.Monad.Reader
import           Control.Monad.Trans.Writer.Strict
import           Data.Aeson
import           Data.Aeson.Types
import qualified Data.ByteString.Lazy as LB
import qualified Data.ByteString.Lazy.Char8 as L8
import           Data.Conduit
import           Data.List
import           Data.Map.Strict (Map)
import qualified Data.Map.Strict as M
import           Data.Maybe.Extra (mapMaybeM)
import           Data.Monoid
import           Data.Set (Set)
import qualified Data.Set as S
import           Data.Text (Text)
import qualified Data.Text as T
import qualified Data.Text.Encoding as T
import qualified Data.Text.IO as T
import qualified Data.Text.Lazy as LT
import           Data.Typeable
import           Network.HTTP.Client.Conduit hiding (path)
import           Network.HTTP.Download
import           Network.HTTP.Types.Status
import           Path
import           Path.IO
import           Stack.Constants
import           Stack.Types
import           Stack.Types.TemplateName
import           System.Process.Run
import           Text.Hastache
import           Text.Hastache.Context
import           Text.ProjectTemplate

--------------------------------------------------------------------------------
-- Main project creation

-- | Options for creating a new project.
data NewOpts = NewOpts
    { newOptsProjectName  :: PackageName
    -- ^ Name of the project to create.
    , newOptsCreateBare   :: Bool
    -- ^ Whether to create the project without a directory.
    , newOptsTemplate     :: TemplateName
    -- ^ Name of the template to use.
    , newOptsNonceParams  :: Map Text Text
    -- ^ Nonce parameters specified just for this invocation.
    }

-- | Create a new project with the given options.
new
    :: (HasConfig r, MonadReader r m, MonadLogger m, MonadCatch m, MonadThrow m, MonadIO m, HasHttpManager r)
    => NewOpts -> m (Path Abs Dir)
new opts = do
    pwd <- getWorkingDir
    absDir <- if bare then return pwd
                      else do relDir <- parseRelDir (packageNameString project)
                              liftM (pwd </>) (return relDir)
    exists <- dirExists absDir
    if exists && not bare
        then throwM (AlreadyExists absDir)
        else do
            logUsing absDir
            templateText <- loadTemplate template
            files <-
                applyTemplate
                    project
                    template
                    (newOptsNonceParams opts)
                    absDir
                    templateText
            writeTemplateFiles files
            runTemplateInits absDir
            return absDir
  where
    template = newOptsTemplate opts
    project = newOptsProjectName opts
    bare = newOptsCreateBare opts
    logUsing absDir =
        $logInfo
            ("Downloading template \"" <> templateName template <>
             "\" to create project \"" <>
             packageNameText project <>
             "\" in " <>
             if bare then "the current directory"
                     else T.pack (toFilePath (dirname absDir)) <>
             " ...")

-- | Download and read in a template's text content.
loadTemplate
    :: forall m r.
       (HasConfig r, HasHttpManager r, MonadReader r m, MonadIO m, MonadThrow m, MonadCatch m)
    => TemplateName -> m Text
loadTemplate name =
    case templatePath name of
        Left absFile -> loadLocalFile absFile
        Right relFile ->
            catch
                (loadLocalFile relFile)
                (\(_ :: NewException) ->
                      downloadTemplate relFile)
  where
    loadLocalFile :: Path b File -> m Text
    loadLocalFile path = do
        exists <- fileExists path
        if exists
            then liftIO (T.readFile (toFilePath path))
            else throwM (FailedToLoadTemplate name (toFilePath path))
    downloadTemplate :: Path Rel File -> m Text
    downloadTemplate rel = do
        config <- asks getConfig
        req <- parseUrl (defaultTemplateUrl <> "/" <> toFilePath rel)
        let path :: Path Abs File
            path = templatesDir config </> rel
        _ <-
            catch
                (redownload req path)
                (throwM . FailedToDownloadTemplate name)
        loadLocalFile path

-- | Apply and unpack a template into a directory.
applyTemplate
    :: (MonadIO m, MonadThrow m, MonadReader r m, HasConfig r, MonadLogger m)
    => PackageName
    -> TemplateName
    -> Map Text Text
    -> Path Abs Dir
    -> Text
{'fraction_non_alphanumeric': 0.08479361370716511, 'fraction_numerical': 0.0003894080996884735, 'mean_word_length': 1.8007088331515813, 'pattern_counts': {'":': 0, '<': 44, '<?xml version=': 0, '>': 51, 'https://': 0, 'lorem ipsum': 0, 'www.': 0, 'xml': 0}, 'pii_count': 0, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 16, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '459945', 'n_tokens_mistral': 2670, 'n_tokens_neox': 2604, 'n_words': 887}