{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE BangPatterns #-}
-- |
-- Module      :  Distribution.Client.Init.Types
-- Copyright   :  (c) Brent Yorgey, Benedikt Huber 2009
-- License     :  BSD-like
--
-- Maintainer  :  cabal-devel@haskell.org
-- Stability   :  provisional
-- Portability :  portable
--
-- Some types used by the 'cabal init' command.
--
module Distribution.Client.Init.Types
( -- * Data
  InitFlags(..)
  -- ** Targets and descriptions
, PkgDescription(..)
, LibTarget(..)
, ExeTarget(..)
, TestTarget(..)
  -- ** package types
, PackageType(..)
  -- ** Main file
, HsFilePath(..)
, HsFileType(..)
, fromHsFilePath
, toHsFilePath
, toLiterateHs
, toStandardHs
, mkLiterate
, isHsFilePath
  -- * Typeclasses
, Interactive(..)
, BreakException(..)
, PurePrompt(..)
, evalPrompt
, Severity(..)
  -- * Aliases
, IsLiterate
, IsSimple
  -- * File creator opts
, WriteOpts(..)
, ProjectSettings(..)
  -- * Formatters
, FieldAnnotation(..)
  -- * Other conveniences
, DefaultPrompt(..)
) where


import qualified Distribution.Client.Compat.Prelude as P
import Distribution.Client.Compat.Prelude as P hiding (getLine, putStr, putStrLn)
import Prelude (read)

import Control.Monad.Catch

import Data.List.NonEmpty (fromList)

import Distribution.Simple.Setup (Flag(..))
import Distribution.Types.Dependency as P
import Distribution.Verbosity (silent)
import Distribution.Version
import qualified Distribution.Package as P
import Distribution.ModuleName
import Distribution.CabalSpecVersion
import Distribution.Client.Utils as P
import Distribution.Fields.Pretty
import Language.Haskell.Extension ( Language(..), Extension )
import qualified System.IO

import qualified System.Directory as P
import qualified System.Process as Process
import qualified Distribution.Compat.Environment as P
import System.FilePath
import Distribution.FieldGrammar.Newtypes (SpecLicense)


-- -------------------------------------------------------------------- --
-- Flags

-- | InitFlags is a subset of flags available in the
-- @.cabal@ file that represent options that are relevant to the
-- init command process.
--
data InitFlags =
    InitFlags
    { InitFlags -> Flag Bool
interactive :: Flag Bool
    , InitFlags -> Flag Bool
quiet :: Flag Bool
    , InitFlags -> Flag String
packageDir :: Flag FilePath
    , InitFlags -> Flag Bool
noComments :: Flag Bool
    , InitFlags -> Flag Bool
minimal :: Flag Bool
    , InitFlags -> Flag Bool
simpleProject :: Flag Bool
    , InitFlags -> Flag PackageName
packageName :: Flag P.PackageName
    , InitFlags -> Flag Version
version :: Flag Version
    , InitFlags -> Flag CabalSpecVersion
cabalVersion :: Flag CabalSpecVersion
    , InitFlags -> Flag SpecLicense
license :: Flag SpecLicense
    , InitFlags -> Flag String
author :: Flag String
    , InitFlags -> Flag String
email :: Flag String
    , InitFlags -> Flag String
homepage :: Flag String
    , InitFlags -> Flag String
synopsis :: Flag String
    , InitFlags -> Flag String
category :: Flag String
    , InitFlags -> Flag [String]
extraSrc :: Flag [String]
    , InitFlags -> Flag [String]
extraDoc :: Flag [String]
    , InitFlags -> Flag PackageType
packageType :: Flag PackageType
    , InitFlags -> Flag String
mainIs :: Flag FilePath
    , InitFlags -> Flag Language
language :: Flag Language
    , InitFlags -> Flag [ModuleName]
exposedModules :: Flag [ModuleName]
    , InitFlags -> Flag [ModuleName]
otherModules :: Flag [ModuleName]
    , InitFlags -> Flag [Extension]
otherExts :: Flag [Extension]
    , InitFlags -> Flag [Dependency]
dependencies :: Flag [P.Dependency]
    , InitFlags -> Flag [String]
applicationDirs :: Flag [String]
    , InitFlags -> Flag [String]
sourceDirs :: Flag [String]
    , InitFlags -> Flag [String]
buildTools :: Flag [String]
    , InitFlags -> Flag Bool
initializeTestSuite :: Flag Bool
    , InitFlags -> Flag [String]
testDirs :: Flag [String]
    , InitFlags -> Flag String
initHcPath :: Flag FilePath
    , InitFlags -> Flag Verbosity
initVerbosity :: Flag Verbosity
    , InitFlags -> Flag Bool
overwrite :: Flag Bool
    } deriving (InitFlags -> InitFlags -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: InitFlags -> InitFlags -> Bool
$c/= :: InitFlags -> InitFlags -> Bool
== :: InitFlags -> InitFlags -> Bool
$c== :: InitFlags -> InitFlags -> Bool
Eq, Int -> InitFlags -> ShowS
[InitFlags] -> ShowS
InitFlags -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [InitFlags] -> ShowS
$cshowList :: [InitFlags] -> ShowS
show :: InitFlags -> String
$cshow :: InitFlags -> String
showsPrec :: Int -> InitFlags -> ShowS
$cshowsPrec :: Int -> InitFlags -> ShowS
Show, forall x. Rep InitFlags x -> InitFlags
forall x. InitFlags -> Rep InitFlags x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep InitFlags x -> InitFlags
$cfrom :: forall x. InitFlags -> Rep InitFlags x
Generic)

instance Monoid InitFlags where
  mempty :: InitFlags
mempty = forall a. (Generic a, GMonoid (Rep a)) => a
gmempty
  mappend :: InitFlags -> InitFlags -> InitFlags
mappend = forall a. Semigroup a => a -> a -> a
(<>)

instance Semigroup InitFlags where
  <> :: InitFlags -> InitFlags -> InitFlags
(<>) = forall a. (Generic a, GSemigroup (Rep a)) => a -> a -> a
gmappend

-- -------------------------------------------------------------------- --
-- Targets

-- | 'PkgDescription' represents the relevant options set by the
-- user when building a package description during the init command
-- process.
--
data PkgDescription = PkgDescription
    { PkgDescription -> CabalSpecVersion
_pkgCabalVersion :: CabalSpecVersion
    , PkgDescription -> PackageName
_pkgName :: P.PackageName
    , PkgDescription -> Version
_pkgVersion :: Version
    , PkgDescription -> SpecLicense
_pkgLicense :: SpecLicense
    , PkgDescription -> String
_pkgAuthor :: String
    , PkgDescription -> String
_pkgEmail :: String
    , PkgDescription -> String
_pkgHomePage :: String
    , PkgDescription -> String
_pkgSynopsis :: String
    , PkgDescription -> String
_pkgCategory :: String
    , PkgDescription -> Set String
_pkgExtraSrcFiles :: Set String
    , PkgDescription -> Maybe (Set String)
_pkgExtraDocFiles :: Maybe (Set String)
    } deriving (Int -> PkgDescription -> ShowS
[PkgDescription] -> ShowS
PkgDescription -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PkgDescription] -> ShowS
$cshowList :: [PkgDescription] -> ShowS
show :: PkgDescription -> String
$cshow :: PkgDescription -> String
showsPrec :: Int -> PkgDescription -> ShowS
$cshowsPrec :: Int -> PkgDescription -> ShowS
Show, PkgDescription -> PkgDescription -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PkgDescription -> PkgDescription -> Bool
$c/= :: PkgDescription -> PkgDescription -> Bool
== :: PkgDescription -> PkgDescription -> Bool
$c== :: PkgDescription -> PkgDescription -> Bool
Eq)

-- | 'LibTarget' represents the relevant options set by the
-- user when building a library package during the init command
-- process.
--
data LibTarget = LibTarget
    { LibTarget -> [String]
_libSourceDirs :: [String]
    , LibTarget -> Language
_libLanguage :: Language
    , LibTarget -> NonEmpty ModuleName
_libExposedModules :: NonEmpty ModuleName
    , LibTarget -> [ModuleName]
_libOtherModules :: [ModuleName]
    , LibTarget -> [Extension]
_libOtherExts :: [Extension]
    , LibTarget -> [Dependency]
_libDependencies :: [P.Dependency]
    , LibTarget -> [Dependency]
_libBuildTools :: [P.Dependency]
    } deriving (Int -> LibTarget -> ShowS
[LibTarget] -> ShowS
LibTarget -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [LibTarget] -> ShowS
$cshowList :: [LibTarget] -> ShowS
show :: LibTarget -> String
$cshow :: LibTarget -> String
showsPrec :: Int -> LibTarget -> ShowS
$cshowsPrec :: Int -> LibTarget -> ShowS
Show, LibTarget -> LibTarget -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LibTarget -> LibTarget -> Bool
$c/= :: LibTarget -> LibTarget -> Bool
== :: LibTarget -> LibTarget -> Bool
$c== :: LibTarget -> LibTarget -> Bool
Eq)

-- | 'ExeTarget' represents the relevant options set by the
-- user when building an executable package.
--
data ExeTarget = ExeTarget
    { ExeTarget -> HsFilePath
_exeMainIs :: HsFilePath
    , ExeTarget -> [String]
_exeApplicationDirs :: [String]
    , ExeTarget -> Language
_exeLanguage :: Language
    , ExeTarget -> [ModuleName]
_exeOtherModules :: [ModuleName]
    , ExeTarget -> [Extension]
_exeOtherExts :: [Extension]
    , ExeTarget -> [Dependency]
_exeDependencies :: [P.Dependency]
    , ExeTarget -> [Dependency]
_exeBuildTools :: [P.Dependency]
    } deriving (Int -> ExeTarget -> ShowS
[ExeTarget] -> ShowS
ExeTarget -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ExeTarget] -> ShowS
$cshowList :: [ExeTarget] -> ShowS
show :: ExeTarget -> String
$cshow :: ExeTarget -> String
showsPrec :: Int -> ExeTarget -> ShowS
$cshowsPrec :: Int -> ExeTarget -> ShowS
Show, ExeTarget -> ExeTarget -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ExeTarget -> ExeTarget -> Bool
$c/= :: ExeTarget -> ExeTarget -> Bool
== :: ExeTarget -> ExeTarget -> Bool
$c== :: ExeTarget -> ExeTarget -> Bool
Eq)

-- | 'TestTarget' represents the relevant options set by the
-- user when building a library package.
--
data TestTarget = TestTarget
    { TestTarget -> HsFilePath
_testMainIs :: HsFilePath
    , TestTarget -> [String]
_testDirs :: [String]
    , TestTarget -> Language
_testLanguage :: Language
    , TestTarget -> [ModuleName]
_testOtherModules :: [ModuleName]
    , TestTarget -> [Extension]
_testOtherExts :: [Extension]
    , TestTarget -> [Dependency]
_testDependencies :: [P.Dependency]
    , TestTarget -> [Dependency]
_testBuildTools :: [P.Dependency]
    } deriving (Int -> TestTarget -> ShowS
[TestTarget] -> ShowS
TestTarget -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TestTarget] -> ShowS
$cshowList :: [TestTarget] -> ShowS
show :: TestTarget -> String
$cshow :: TestTarget -> String
showsPrec :: Int -> TestTarget -> ShowS
$cshowsPrec :: Int -> TestTarget -> ShowS
Show, TestTarget -> TestTarget -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TestTarget -> TestTarget -> Bool
$c/= :: TestTarget -> TestTarget -> Bool
== :: TestTarget -> TestTarget -> Bool
$c== :: TestTarget -> TestTarget -> Bool
Eq)

-- -------------------------------------------------------------------- --
-- File creator options

data WriteOpts = WriteOpts
    { WriteOpts -> Bool
_optOverwrite :: Bool
    , WriteOpts -> Bool
_optMinimal :: Bool
    , WriteOpts -> Bool
_optNoComments :: Bool
    , WriteOpts -> Verbosity
_optVerbosity :: Verbosity
    , WriteOpts -> String
_optPkgDir :: FilePath
    , WriteOpts -> PackageType
_optPkgType :: PackageType
    , WriteOpts -> PackageName
_optPkgName :: P.PackageName
    , WriteOpts -> CabalSpecVersion
_optCabalSpec :: CabalSpecVersion
    } deriving (WriteOpts -> WriteOpts -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: WriteOpts -> WriteOpts -> Bool
$c/= :: WriteOpts -> WriteOpts -> Bool
== :: WriteOpts -> WriteOpts -> Bool
$c== :: WriteOpts -> WriteOpts -> Bool
Eq, Int -> WriteOpts -> ShowS
[WriteOpts] -> ShowS
WriteOpts -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [WriteOpts] -> ShowS
$cshowList :: [WriteOpts] -> ShowS
show :: WriteOpts -> String
$cshow :: WriteOpts -> String
showsPrec :: Int -> WriteOpts -> ShowS
$cshowsPrec :: Int -> WriteOpts -> ShowS
Show)

data ProjectSettings = ProjectSettings
    { ProjectSettings -> WriteOpts
_pkgOpts :: WriteOpts
    , ProjectSettings -> PkgDescription
_pkgDesc :: PkgDescription
    , ProjectSettings -> Maybe LibTarget
_pkgLibTarget :: Maybe LibTarget
    , ProjectSettings -> Maybe ExeTarget
_pkgExeTarget :: Maybe ExeTarget
    , ProjectSettings -> Maybe TestTarget
_pkgTestTarget :: Maybe TestTarget
    } deriving (ProjectSettings -> ProjectSettings -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ProjectSettings -> ProjectSettings -> Bool
$c/= :: ProjectSettings -> ProjectSettings -> Bool
== :: ProjectSettings -> ProjectSettings -> Bool
$c== :: ProjectSettings -> ProjectSettings -> Bool
Eq, Int -> ProjectSettings -> ShowS
[ProjectSettings] -> ShowS
ProjectSettings -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ProjectSettings] -> ShowS
$cshowList :: [ProjectSettings] -> ShowS
show :: ProjectSettings -> String
$cshow :: ProjectSettings -> String
showsPrec :: Int -> ProjectSettings -> ShowS
$cshowsPrec :: Int -> ProjectSettings -> ShowS
Show)

-- -------------------------------------------------------------------- --
-- Other types

-- | Enum to denote whether the user wants to build a library target,
-- executable target, library and executable targets, or a standalone test suite.
--
data PackageType = Library | Executable | LibraryAndExecutable | TestSuite
    deriving (PackageType -> PackageType -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PackageType -> PackageType -> Bool
$c/= :: PackageType -> PackageType -> Bool
== :: PackageType -> PackageType -> Bool
$c== :: PackageType -> PackageType -> Bool
Eq, Int -> PackageType -> ShowS
[PackageType] -> ShowS
PackageType -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PackageType] -> ShowS
$cshowList :: [PackageType] -> ShowS
show :: PackageType -> String
$cshow :: PackageType -> String
showsPrec :: Int -> PackageType -> ShowS
$cshowsPrec :: Int -> PackageType -> ShowS
Show, forall x. Rep PackageType x -> PackageType
forall x. PackageType -> Rep PackageType x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep PackageType x -> PackageType
$cfrom :: forall x. PackageType -> Rep PackageType x
Generic)

data HsFileType
    = Literate
    | Standard
    | InvalidHsPath
    deriving (HsFileType -> HsFileType -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: HsFileType -> HsFileType -> Bool
$c/= :: HsFileType -> HsFileType -> Bool
== :: HsFileType -> HsFileType -> Bool
$c== :: HsFileType -> HsFileType -> Bool
Eq, Int -> HsFileType -> ShowS
[HsFileType] -> ShowS
HsFileType -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [HsFileType] -> ShowS
$cshowList :: [HsFileType] -> ShowS
show :: HsFileType -> String
$cshow :: HsFileType -> String
showsPrec :: Int -> HsFileType -> ShowS
$cshowsPrec :: Int -> HsFileType -> ShowS
Show)

data HsFilePath = HsFilePath
    { HsFilePath -> String
_hsFilePath :: FilePath
    , HsFilePath -> HsFileType
_hsFileType :: HsFileType
    } deriving HsFilePath -> HsFilePath -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: HsFilePath -> HsFilePath -> Bool
$c/= :: HsFilePath -> HsFilePath -> Bool
== :: HsFilePath -> HsFilePath -> Bool
$c== :: HsFilePath -> HsFilePath -> Bool
Eq

instance Show HsFilePath where
    show :: HsFilePath -> String
show (HsFilePath String
fp HsFileType
ty) = case HsFileType
ty of
      HsFileType
Literate -> String
fp
      HsFileType
Standard -> String
fp
      HsFileType
InvalidHsPath -> String
"Invalid haskell source file: " forall a. [a] -> [a] -> [a]
++ String
fp

fromHsFilePath :: HsFilePath -> Maybe FilePath
fromHsFilePath :: HsFilePath -> Maybe String
fromHsFilePath (HsFilePath String
fp HsFileType
ty) = case HsFileType
ty of
    HsFileType
Literate -> forall a. a -> Maybe a
Just String
fp
    HsFileType
Standard -> forall a. a -> Maybe a
Just String
fp
    HsFileType
InvalidHsPath -> forall a. Maybe a
Nothing

isHsFilePath :: FilePath -> Bool
isHsFilePath :: String -> Bool
isHsFilePath String
fp = case HsFilePath -> HsFileType
_hsFileType forall a b. (a -> b) -> a -> b
$ String -> HsFilePath
toHsFilePath String
fp of
    HsFileType
InvalidHsPath -> Bool
False
    HsFileType
_ -> Bool
True

toHsFilePath :: FilePath -> HsFilePath
toHsFilePath :: String -> HsFilePath
toHsFilePath String
fp
    | ShowS
takeExtension String
fp forall a. Eq a => a -> a -> Bool
== String
".lhs" = String -> HsFileType -> HsFilePath
HsFilePath String
fp HsFileType
Literate
    | ShowS
takeExtension String
fp forall a. Eq a => a -> a -> Bool
== String
".hs" = String -> HsFileType -> HsFilePath
HsFilePath String
fp HsFileType
Standard
    | Bool
otherwise = String -> HsFileType -> HsFilePath
HsFilePath String
fp HsFileType
InvalidHsPath

toLiterateHs :: HsFilePath -> HsFilePath
toLiterateHs :: HsFilePath -> HsFilePath
toLiterateHs (HsFilePath String
fp HsFileType
Standard) = String -> HsFileType -> HsFilePath
HsFilePath
    (ShowS
dropExtension String
fp forall a. [a] -> [a] -> [a]
++ String
".lhs")
    HsFileType
Literate
toLiterateHs HsFilePath
a = HsFilePath
a

toStandardHs :: HsFilePath -> HsFilePath
toStandardHs :: HsFilePath -> HsFilePath
toStandardHs (HsFilePath String
fp HsFileType
Literate) = String -> HsFileType -> HsFilePath
HsFilePath
    (ShowS
dropExtension String
fp forall a. [a] -> [a] -> [a]
++ String
".hs")
    HsFileType
Standard
toStandardHs HsFilePath
a = HsFilePath
a

mkLiterate :: HsFilePath -> [String] -> [String]
mkLiterate :: HsFilePath -> [String] -> [String]
mkLiterate (HsFilePath String
_ HsFileType
Literate) [String]
hs =
    (\String
line -> if forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
line then String
line else String
"> " forall a. [a] -> [a] -> [a]
++ String
line) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [String]
hs
mkLiterate HsFilePath
_ [String]
hs = [String]
hs

-- -------------------------------------------------------------------- --
-- Interactive prompt monad

newtype PurePrompt a = PurePrompt
    { forall a.
PurePrompt a
-> NonEmpty String -> Either BreakException (a, NonEmpty String)
_runPrompt
        :: NonEmpty String
        -> Either BreakException (a, NonEmpty String)
    } deriving (forall a b. a -> PurePrompt b -> PurePrompt a
forall a b. (a -> b) -> PurePrompt a -> PurePrompt b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> PurePrompt b -> PurePrompt a
$c<$ :: forall a b. a -> PurePrompt b -> PurePrompt a
fmap :: forall a b. (a -> b) -> PurePrompt a -> PurePrompt b
$cfmap :: forall a b. (a -> b) -> PurePrompt a -> PurePrompt b
Functor)

evalPrompt :: PurePrompt a -> NonEmpty String -> a
evalPrompt :: forall a. PurePrompt a -> NonEmpty String -> a
evalPrompt PurePrompt a
act NonEmpty String
s = case forall a.
PurePrompt a
-> NonEmpty String -> Either BreakException (a, NonEmpty String)
_runPrompt PurePrompt a
act NonEmpty String
s of
    Left BreakException
e -> forall a. HasCallStack => String -> a
error forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show BreakException
e
    Right (a
a,NonEmpty String
_) -> a
a

instance Applicative PurePrompt where
    pure :: forall a. a -> PurePrompt a
pure a
a = forall a.
(NonEmpty String -> Either BreakException (a, NonEmpty String))
-> PurePrompt a
PurePrompt forall a b. (a -> b) -> a -> b
$ \NonEmpty String
s -> forall a b. b -> Either a b
Right (a
a, NonEmpty String
s)
    PurePrompt NonEmpty String -> Either BreakException (a -> b, NonEmpty String)
ff <*> :: forall a b. PurePrompt (a -> b) -> PurePrompt a -> PurePrompt b
<*> PurePrompt NonEmpty String -> Either BreakException (a, NonEmpty String)
aa = forall a.
(NonEmpty String -> Either BreakException (a, NonEmpty String))
-> PurePrompt a
PurePrompt forall a b. (a -> b) -> a -> b
$ \NonEmpty String
s -> case NonEmpty String -> Either BreakException (a -> b, NonEmpty String)
ff NonEmpty String
s of
      Left BreakException
e -> forall a b. a -> Either a b
Left BreakException
e
      Right (a -> b
f, NonEmpty String
s') -> case NonEmpty String -> Either BreakException (a, NonEmpty String)
aa NonEmpty String
s' of
        Left BreakException
e -> forall a b. a -> Either a b
Left BreakException
e
        Right (a
a, NonEmpty String
s'') -> forall a b. b -> Either a b
Right (a -> b
f a
a, NonEmpty String
s'')

instance Monad PurePrompt where
    return :: forall a. a -> PurePrompt a
return = forall (f :: * -> *) a. Applicative f => a -> f a
pure
    PurePrompt NonEmpty String -> Either BreakException (a, NonEmpty String)
a >>= :: forall a b. PurePrompt a -> (a -> PurePrompt b) -> PurePrompt b
>>= a -> PurePrompt b
k = forall a.
(NonEmpty String -> Either BreakException (a, NonEmpty String))
-> PurePrompt a
PurePrompt forall a b. (a -> b) -> a -> b
$ \NonEmpty String
s -> case NonEmpty String -> Either BreakException (a, NonEmpty String)
a NonEmpty String
s of
      Left BreakException
e -> forall a b. a -> Either a b
Left BreakException
e
      Right (a
a', NonEmpty String
s') -> forall a.
PurePrompt a
-> NonEmpty String -> Either BreakException (a, NonEmpty String)
_runPrompt (a -> PurePrompt b
k a
a') NonEmpty String
s'

class Monad m => Interactive m where
    -- input functions
    getLine :: m String
    readFile :: FilePath -> m String
    getCurrentDirectory :: m FilePath
    getHomeDirectory :: m FilePath
    getDirectoryContents :: FilePath -> m [FilePath]
    listDirectory :: FilePath -> m [FilePath]
    doesDirectoryExist :: FilePath -> m Bool
    doesFileExist :: FilePath -> m Bool
    canonicalizePathNoThrow :: FilePath -> m FilePath
    readProcessWithExitCode :: FilePath -> [String] -> String -> m (ExitCode, String, String)
    getEnvironment :: m [(String, String)]
    getCurrentYear :: m Integer
    listFilesInside :: (FilePath -> m Bool) -> FilePath -> m [FilePath]
    listFilesRecursive :: FilePath -> m [FilePath]

    -- output functions
    putStr :: String -> m ()
    putStrLn :: String -> m ()
    createDirectory :: FilePath -> m ()
    removeDirectory :: FilePath -> m ()
    writeFile :: FilePath -> String -> m ()
    removeExistingFile :: FilePath -> m ()
    copyFile :: FilePath -> FilePath -> m ()
    renameDirectory :: FilePath -> FilePath -> m ()
    hFlush :: System.IO.Handle -> m ()
    message :: Verbosity -> Severity -> String -> m ()

    -- misc functions
    break :: m Bool
    throwPrompt :: BreakException -> m a

instance Interactive IO where
    getLine :: IO String
getLine = IO String
P.getLine
    readFile :: String -> IO String
readFile = String -> IO String
P.readFile
    getCurrentDirectory :: IO String
getCurrentDirectory = IO String
P.getCurrentDirectory
    getHomeDirectory :: IO String
getHomeDirectory = IO String
P.getHomeDirectory
    getDirectoryContents :: String -> IO [String]
getDirectoryContents = String -> IO [String]
P.getDirectoryContents
    listDirectory :: String -> IO [String]
listDirectory = String -> IO [String]
P.listDirectory
    doesDirectoryExist :: String -> IO Bool
doesDirectoryExist = String -> IO Bool
P.doesDirectoryExist
    doesFileExist :: String -> IO Bool
doesFileExist = String -> IO Bool
P.doesFileExist
    canonicalizePathNoThrow :: String -> IO String
canonicalizePathNoThrow = String -> IO String
P.canonicalizePathNoThrow
    readProcessWithExitCode :: String -> [String] -> String -> IO (ExitCode, String, String)
readProcessWithExitCode = String -> [String] -> String -> IO (ExitCode, String, String)
Process.readProcessWithExitCode
    getEnvironment :: IO [(String, String)]
getEnvironment = IO [(String, String)]
P.getEnvironment
    getCurrentYear :: IO Integer
getCurrentYear = IO Integer
P.getCurrentYear
    listFilesInside :: (String -> IO Bool) -> String -> IO [String]
listFilesInside = (String -> IO Bool) -> String -> IO [String]
P.listFilesInside
    listFilesRecursive :: String -> IO [String]
listFilesRecursive = String -> IO [String]
P.listFilesRecursive

    putStr :: String -> IO ()
putStr = String -> IO ()
P.putStr
    putStrLn :: String -> IO ()
putStrLn = String -> IO ()
P.putStrLn
    createDirectory :: String -> IO ()
createDirectory = String -> IO ()
P.createDirectory
    removeDirectory :: String -> IO ()
removeDirectory = String -> IO ()
P.removeDirectoryRecursive
    writeFile :: String -> String -> IO ()
writeFile = String -> String -> IO ()
P.writeFile
    removeExistingFile :: String -> IO ()
removeExistingFile = String -> IO ()
P.removeExistingFile
    copyFile :: String -> String -> IO ()
copyFile = String -> String -> IO ()
P.copyFile
    renameDirectory :: String -> String -> IO ()
renameDirectory = String -> String -> IO ()
P.renameDirectory
    hFlush :: Handle -> IO ()
hFlush = Handle -> IO ()
System.IO.hFlush
    message :: Verbosity -> Severity -> String -> IO ()
message Verbosity
q Severity
severity String
msg
      | Verbosity
q forall a. Eq a => a -> a -> Bool
== Verbosity
silent = forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
      | Bool
otherwise  = forall (m :: * -> *). Interactive m => String -> m ()
putStrLn forall a b. (a -> b) -> a -> b
$ String
"[" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Severity
severity forall a. [a] -> [a] -> [a]
++ String
"] " forall a. [a] -> [a] -> [a]
++ String
msg
    break :: IO Bool
break = forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
    throwPrompt :: forall a. BreakException -> IO a
throwPrompt = forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM

instance Interactive PurePrompt where
    getLine :: PurePrompt String
getLine = PurePrompt String
pop
    readFile :: String -> PurePrompt String
readFile !String
_ = PurePrompt String
pop
    getCurrentDirectory :: PurePrompt String
getCurrentDirectory = PurePrompt String
popAbsolute
    getHomeDirectory :: PurePrompt String
getHomeDirectory = PurePrompt String
popAbsolute
    -- expects stack input of form "[\"foo\", \"bar\", \"baz\"]"
    getDirectoryContents :: String -> PurePrompt [String]
getDirectoryContents !String
_ = PurePrompt [String]
popList
    listDirectory :: String -> PurePrompt [String]
listDirectory !String
_ = PurePrompt [String]
popList
    doesDirectoryExist :: String -> PurePrompt Bool
doesDirectoryExist !String
_ = PurePrompt Bool
popBool
    doesFileExist :: String -> PurePrompt Bool
doesFileExist !String
_ = PurePrompt Bool
popBool
    canonicalizePathNoThrow :: String -> PurePrompt String
canonicalizePathNoThrow !String
_ = PurePrompt String
popAbsolute
    readProcessWithExitCode :: String
-> [String] -> String -> PurePrompt (ExitCode, String, String)
readProcessWithExitCode !String
_ ![String]
_ !String
_ = do
      String
input <- PurePrompt String
pop
      forall (m :: * -> *) a. Monad m => a -> m a
return (ExitCode
ExitSuccess, String
input, String
"")
    getEnvironment :: PurePrompt [(String, String)]
getEnvironment = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a b. (a -> b) -> [a] -> [b]
map forall a. Read a => String -> a
read) PurePrompt [String]
popList
    getCurrentYear :: PurePrompt Integer
getCurrentYear = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. Read a => String -> a
read PurePrompt String
pop
    listFilesInside :: (String -> PurePrompt Bool) -> String -> PurePrompt [String]
listFilesInside String -> PurePrompt Bool
pred' !String
_ = do
      [[String]]
input <- forall a b. (a -> b) -> [a] -> [b]
map String -> [String]
splitDirectories forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> PurePrompt [String]
popList
      forall a b. (a -> b) -> [a] -> [b]
map [String] -> String
joinPath forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) a.
Applicative m =>
(a -> m Bool) -> [a] -> m [a]
filterM (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall (t :: * -> *). Foldable t => t Bool -> Bool
and forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse String -> PurePrompt Bool
pred') [[String]]
input
    listFilesRecursive :: String -> PurePrompt [String]
listFilesRecursive !String
_ = PurePrompt [String]
popList

    putStr :: String -> PurePrompt ()
putStr !String
_ = forall (m :: * -> *) a. Monad m => a -> m a
return ()
    putStrLn :: String -> PurePrompt ()
putStrLn !String
_ = forall (m :: * -> *) a. Monad m => a -> m a
return ()
    createDirectory :: String -> PurePrompt ()
createDirectory !String
d = forall a. String -> a -> PurePrompt a
checkInvalidPath String
d ()
    removeDirectory :: String -> PurePrompt ()
removeDirectory !String
d = forall a. String -> a -> PurePrompt a
checkInvalidPath String
d ()
    writeFile :: String -> String -> PurePrompt ()
writeFile !String
f !String
_ = forall a. String -> a -> PurePrompt a
checkInvalidPath String
f ()
    removeExistingFile :: String -> PurePrompt ()
removeExistingFile !String
f = forall a. String -> a -> PurePrompt a
checkInvalidPath String
f ()
    copyFile :: String -> String -> PurePrompt ()
copyFile !String
f !String
_ = forall a. String -> a -> PurePrompt a
checkInvalidPath String
f ()
    renameDirectory :: String -> String -> PurePrompt ()
renameDirectory !String
d !String
_ = forall a. String -> a -> PurePrompt a
checkInvalidPath String
d ()
    hFlush :: Handle -> PurePrompt ()
hFlush Handle
_ = forall (m :: * -> *) a. Monad m => a -> m a
return ()
    message :: Verbosity -> Severity -> String -> PurePrompt ()
message !Verbosity
_ !Severity
severity !String
msg = case Severity
severity of
      Severity
Error -> forall a.
(NonEmpty String -> Either BreakException (a, NonEmpty String))
-> PurePrompt a
PurePrompt forall a b. (a -> b) -> a -> b
$ \NonEmpty String
_ -> forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ String -> BreakException
BreakException
        (forall a. Show a => a -> String
show Severity
severity forall a. [a] -> [a] -> [a]
++ String
": " forall a. [a] -> [a] -> [a]
++ String
msg)
      Severity
_     -> forall (m :: * -> *) a. Monad m => a -> m a
return ()

    break :: PurePrompt Bool
break = forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
    throwPrompt :: forall a. BreakException -> PurePrompt a
throwPrompt (BreakException String
e) = forall a.
(NonEmpty String -> Either BreakException (a, NonEmpty String))
-> PurePrompt a
PurePrompt forall a b. (a -> b) -> a -> b
$ \NonEmpty String
s -> forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ String -> BreakException
BreakException
      (String
"Error: " forall a. [a] -> [a] -> [a]
++ String
e forall a. [a] -> [a] -> [a]
++ String
"\nStacktrace: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show NonEmpty String
s)

pop :: PurePrompt String
pop :: PurePrompt String
pop = forall a.
(NonEmpty String -> Either BreakException (a, NonEmpty String))
-> PurePrompt a
PurePrompt forall a b. (a -> b) -> a -> b
$ \ (String
p:|[String]
ps) -> forall a b. b -> Either a b
Right (String
p,forall a. [a] -> NonEmpty a
fromList [String]
ps)

popAbsolute :: PurePrompt String
popAbsolute :: PurePrompt String
popAbsolute = do
    String
input <- PurePrompt String
pop
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ String
"/home/test/" forall a. [a] -> [a] -> [a]
++ String
input

popBool :: PurePrompt Bool
popBool :: PurePrompt Bool
popBool = PurePrompt String
pop forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    String
"True" -> forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
True
    String
"False" -> forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False
    String
s -> forall (m :: * -> *) a. Interactive m => BreakException -> m a
throwPrompt forall a b. (a -> b) -> a -> b
$ String -> BreakException
BreakException forall a b. (a -> b) -> a -> b
$ String
"popBool: " forall a. [a] -> [a] -> [a]
++ String
s

popList :: PurePrompt [String]
popList :: PurePrompt [String]
popList = PurePrompt String
pop forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \String
a -> case forall a. Read a => String -> Maybe a
P.safeRead String
a of
    Maybe [String]
Nothing -> forall (m :: * -> *) a. Interactive m => BreakException -> m a
throwPrompt forall a b. (a -> b) -> a -> b
$ String -> BreakException
BreakException (String
"popList: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show String
a)
    Just [String]
as -> forall (m :: * -> *) a. Monad m => a -> m a
return [String]
as

checkInvalidPath :: String -> a -> PurePrompt a
checkInvalidPath :: forall a. String -> a -> PurePrompt a
checkInvalidPath String
path a
act =
    -- The check below is done this way so it's easier to append
    -- more invalid paths in the future, if necessary
    if String
path forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String
"."] then
      forall (m :: * -> *) a. Interactive m => BreakException -> m a
throwPrompt forall a b. (a -> b) -> a -> b
$ String -> BreakException
BreakException forall a b. (a -> b) -> a -> b
$ String
"Invalid path: " forall a. [a] -> [a] -> [a]
++ String
path
    else
      forall (m :: * -> *) a. Monad m => a -> m a
return a
act

-- | A pure exception thrown exclusively by the pure prompter
-- to cancel infinite loops in the prompting process.
--
-- For example, in order to break on parse errors, or user-driven
-- continuations that do not make sense to test.
--
newtype BreakException = BreakException String deriving (BreakException -> BreakException -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BreakException -> BreakException -> Bool
$c/= :: BreakException -> BreakException -> Bool
== :: BreakException -> BreakException -> Bool
$c== :: BreakException -> BreakException -> Bool
Eq, Int -> BreakException -> ShowS
[BreakException] -> ShowS
BreakException -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BreakException] -> ShowS
$cshowList :: [BreakException] -> ShowS
show :: BreakException -> String
$cshow :: BreakException -> String
showsPrec :: Int -> BreakException -> ShowS
$cshowsPrec :: Int -> BreakException -> ShowS
Show)

instance Exception BreakException

-- | Used to inform the intent of prompted messages.
--
data Severity = Log | Info | Warning | Error deriving (Severity -> Severity -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Severity -> Severity -> Bool
$c/= :: Severity -> Severity -> Bool
== :: Severity -> Severity -> Bool
$c== :: Severity -> Severity -> Bool
Eq, Int -> Severity -> ShowS
[Severity] -> ShowS
Severity -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Severity] -> ShowS
$cshowList :: [Severity] -> ShowS
show :: Severity -> String
$cshow :: Severity -> String
showsPrec :: Int -> Severity -> ShowS
$cshowsPrec :: Int -> Severity -> ShowS
Show)

-- | Convenience alias for the literate haskell flag
--
type IsLiterate = Bool

-- | Convenience alias for generating simple projects
--
type IsSimple = Bool

-- | Defines whether or not a prompt will have a default value,
--   is optional, or is mandatory.
data DefaultPrompt t
  = DefaultPrompt t
  | OptionalPrompt
  | MandatoryPrompt
  deriving (DefaultPrompt t -> DefaultPrompt t -> Bool
forall t. Eq t => DefaultPrompt t -> DefaultPrompt t -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DefaultPrompt t -> DefaultPrompt t -> Bool
$c/= :: forall t. Eq t => DefaultPrompt t -> DefaultPrompt t -> Bool
== :: DefaultPrompt t -> DefaultPrompt t -> Bool
$c== :: forall t. Eq t => DefaultPrompt t -> DefaultPrompt t -> Bool
Eq, forall a b. a -> DefaultPrompt b -> DefaultPrompt a
forall a b. (a -> b) -> DefaultPrompt a -> DefaultPrompt b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> DefaultPrompt b -> DefaultPrompt a
$c<$ :: forall a b. a -> DefaultPrompt b -> DefaultPrompt a
fmap :: forall a b. (a -> b) -> DefaultPrompt a -> DefaultPrompt b
$cfmap :: forall a b. (a -> b) -> DefaultPrompt a -> DefaultPrompt b
Functor)

-- -------------------------------------------------------------------- --
-- Field annotation for pretty formatters

-- | Annotations for cabal file PrettyField.
data FieldAnnotation = FieldAnnotation
  { FieldAnnotation -> Bool
annCommentedOut :: Bool
    -- ^ True iif the field and its contents should be commented out.
  , FieldAnnotation -> CommentPosition
annCommentLines :: CommentPosition
    -- ^ Comment lines to place before the field or section.
  }