{-# 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 P
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 FilePath
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 FilePath
author :: Flag String
    , InitFlags -> Flag FilePath
email :: Flag String
    , InitFlags -> Flag FilePath
homepage :: Flag String
    , InitFlags -> Flag FilePath
synopsis :: Flag String
    , InitFlags -> Flag FilePath
category :: Flag String
    , InitFlags -> Flag [FilePath]
extraSrc :: Flag [String]
    , InitFlags -> Flag [FilePath]
extraDoc :: Flag [String]
    , InitFlags -> Flag PackageType
packageType :: Flag PackageType
    , InitFlags -> Flag FilePath
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 [FilePath]
applicationDirs :: Flag [String]
    , InitFlags -> Flag [FilePath]
sourceDirs :: Flag [String]
    , InitFlags -> Flag [FilePath]
buildTools :: Flag [String]
    , InitFlags -> Flag Bool
initializeTestSuite :: Flag Bool
    , InitFlags -> Flag [FilePath]
testDirs :: Flag [String]
    , InitFlags -> Flag FilePath
initHcPath :: Flag FilePath
    , InitFlags -> Flag Verbosity
initVerbosity :: Flag Verbosity
    , InitFlags -> Flag Bool
overwrite :: Flag Bool
    } deriving (InitFlags -> InitFlags -> Bool
(InitFlags -> InitFlags -> Bool)
-> (InitFlags -> InitFlags -> Bool) -> Eq InitFlags
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 -> FilePath
(Int -> InitFlags -> ShowS)
-> (InitFlags -> FilePath)
-> ([InitFlags] -> ShowS)
-> Show InitFlags
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [InitFlags] -> ShowS
$cshowList :: [InitFlags] -> ShowS
show :: InitFlags -> FilePath
$cshow :: InitFlags -> FilePath
showsPrec :: Int -> InitFlags -> ShowS
$cshowsPrec :: Int -> InitFlags -> ShowS
Show, (forall x. InitFlags -> Rep InitFlags x)
-> (forall x. Rep InitFlags x -> InitFlags) -> Generic InitFlags
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 = InitFlags
forall a. (Generic a, GMonoid (Rep a)) => a
gmempty
  mappend :: InitFlags -> InitFlags -> InitFlags
mappend = InitFlags -> InitFlags -> InitFlags
forall a. Semigroup a => a -> a -> a
(<>)

instance Semigroup InitFlags where
  <> :: InitFlags -> InitFlags -> InitFlags
(<>) = 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 -> FilePath
_pkgAuthor :: String
    , PkgDescription -> FilePath
_pkgEmail :: String
    , PkgDescription -> FilePath
_pkgHomePage :: String
    , PkgDescription -> FilePath
_pkgSynopsis :: String
    , PkgDescription -> FilePath
_pkgCategory :: String
    , PkgDescription -> Set FilePath
_pkgExtraSrcFiles :: Set String
    , PkgDescription -> Maybe (Set FilePath)
_pkgExtraDocFiles :: Maybe (Set String)
    } deriving (Int -> PkgDescription -> ShowS
[PkgDescription] -> ShowS
PkgDescription -> FilePath
(Int -> PkgDescription -> ShowS)
-> (PkgDescription -> FilePath)
-> ([PkgDescription] -> ShowS)
-> Show PkgDescription
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [PkgDescription] -> ShowS
$cshowList :: [PkgDescription] -> ShowS
show :: PkgDescription -> FilePath
$cshow :: PkgDescription -> FilePath
showsPrec :: Int -> PkgDescription -> ShowS
$cshowsPrec :: Int -> PkgDescription -> ShowS
Show, PkgDescription -> PkgDescription -> Bool
(PkgDescription -> PkgDescription -> Bool)
-> (PkgDescription -> PkgDescription -> Bool) -> Eq PkgDescription
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 -> [FilePath]
_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 -> FilePath
(Int -> LibTarget -> ShowS)
-> (LibTarget -> FilePath)
-> ([LibTarget] -> ShowS)
-> Show LibTarget
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [LibTarget] -> ShowS
$cshowList :: [LibTarget] -> ShowS
show :: LibTarget -> FilePath
$cshow :: LibTarget -> FilePath
showsPrec :: Int -> LibTarget -> ShowS
$cshowsPrec :: Int -> LibTarget -> ShowS
Show, LibTarget -> LibTarget -> Bool
(LibTarget -> LibTarget -> Bool)
-> (LibTarget -> LibTarget -> Bool) -> Eq LibTarget
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 -> [FilePath]
_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 -> FilePath
(Int -> ExeTarget -> ShowS)
-> (ExeTarget -> FilePath)
-> ([ExeTarget] -> ShowS)
-> Show ExeTarget
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [ExeTarget] -> ShowS
$cshowList :: [ExeTarget] -> ShowS
show :: ExeTarget -> FilePath
$cshow :: ExeTarget -> FilePath
showsPrec :: Int -> ExeTarget -> ShowS
$cshowsPrec :: Int -> ExeTarget -> ShowS
Show, ExeTarget -> ExeTarget -> Bool
(ExeTarget -> ExeTarget -> Bool)
-> (ExeTarget -> ExeTarget -> Bool) -> Eq ExeTarget
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 -> [FilePath]
_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 -> FilePath
(Int -> TestTarget -> ShowS)
-> (TestTarget -> FilePath)
-> ([TestTarget] -> ShowS)
-> Show TestTarget
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [TestTarget] -> ShowS
$cshowList :: [TestTarget] -> ShowS
show :: TestTarget -> FilePath
$cshow :: TestTarget -> FilePath
showsPrec :: Int -> TestTarget -> ShowS
$cshowsPrec :: Int -> TestTarget -> ShowS
Show, TestTarget -> TestTarget -> Bool
(TestTarget -> TestTarget -> Bool)
-> (TestTarget -> TestTarget -> Bool) -> Eq TestTarget
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 -> FilePath
_optPkgDir :: FilePath
    , WriteOpts -> PackageType
_optPkgType :: PackageType
    , WriteOpts -> PackageName
_optPkgName :: P.PackageName
    , WriteOpts -> CabalSpecVersion
_optCabalSpec :: CabalSpecVersion
    } deriving (WriteOpts -> WriteOpts -> Bool
(WriteOpts -> WriteOpts -> Bool)
-> (WriteOpts -> WriteOpts -> Bool) -> Eq WriteOpts
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 -> FilePath
(Int -> WriteOpts -> ShowS)
-> (WriteOpts -> FilePath)
-> ([WriteOpts] -> ShowS)
-> Show WriteOpts
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [WriteOpts] -> ShowS
$cshowList :: [WriteOpts] -> ShowS
show :: WriteOpts -> FilePath
$cshow :: WriteOpts -> FilePath
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
(ProjectSettings -> ProjectSettings -> Bool)
-> (ProjectSettings -> ProjectSettings -> Bool)
-> Eq ProjectSettings
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 -> FilePath
(Int -> ProjectSettings -> ShowS)
-> (ProjectSettings -> FilePath)
-> ([ProjectSettings] -> ShowS)
-> Show ProjectSettings
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [ProjectSettings] -> ShowS
$cshowList :: [ProjectSettings] -> ShowS
show :: ProjectSettings -> FilePath
$cshow :: ProjectSettings -> FilePath
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
(PackageType -> PackageType -> Bool)
-> (PackageType -> PackageType -> Bool) -> Eq PackageType
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 -> FilePath
(Int -> PackageType -> ShowS)
-> (PackageType -> FilePath)
-> ([PackageType] -> ShowS)
-> Show PackageType
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [PackageType] -> ShowS
$cshowList :: [PackageType] -> ShowS
show :: PackageType -> FilePath
$cshow :: PackageType -> FilePath
showsPrec :: Int -> PackageType -> ShowS
$cshowsPrec :: Int -> PackageType -> ShowS
Show, (forall x. PackageType -> Rep PackageType x)
-> (forall x. Rep PackageType x -> PackageType)
-> Generic PackageType
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
(HsFileType -> HsFileType -> Bool)
-> (HsFileType -> HsFileType -> Bool) -> Eq HsFileType
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 -> FilePath
(Int -> HsFileType -> ShowS)
-> (HsFileType -> FilePath)
-> ([HsFileType] -> ShowS)
-> Show HsFileType
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [HsFileType] -> ShowS
$cshowList :: [HsFileType] -> ShowS
show :: HsFileType -> FilePath
$cshow :: HsFileType -> FilePath
showsPrec :: Int -> HsFileType -> ShowS
$cshowsPrec :: Int -> HsFileType -> ShowS
Show)

data HsFilePath = HsFilePath
    { HsFilePath -> FilePath
_hsFilePath :: FilePath
    , HsFilePath -> HsFileType
_hsFileType :: HsFileType
    } deriving HsFilePath -> HsFilePath -> Bool
(HsFilePath -> HsFilePath -> Bool)
-> (HsFilePath -> HsFilePath -> Bool) -> Eq HsFilePath
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 -> FilePath
show (HsFilePath FilePath
fp HsFileType
ty) = case HsFileType
ty of
      HsFileType
Literate -> FilePath
fp
      HsFileType
Standard -> FilePath
fp
      HsFileType
InvalidHsPath -> FilePath
"Invalid haskell source file: " FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
fp

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

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

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

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

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

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

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

newtype PurePrompt a = PurePrompt
    { PurePrompt a
-> NonEmpty FilePath
-> Either BreakException (a, NonEmpty FilePath)
_runPrompt
        :: NonEmpty String
        -> Either BreakException (a, NonEmpty String)
    } deriving (a -> PurePrompt b -> PurePrompt a
(a -> b) -> PurePrompt a -> PurePrompt b
(forall a b. (a -> b) -> PurePrompt a -> PurePrompt b)
-> (forall a b. a -> PurePrompt b -> PurePrompt a)
-> Functor PurePrompt
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
<$ :: a -> PurePrompt b -> PurePrompt a
$c<$ :: forall a b. a -> PurePrompt b -> PurePrompt a
fmap :: (a -> b) -> PurePrompt a -> PurePrompt b
$cfmap :: forall a b. (a -> b) -> PurePrompt a -> PurePrompt b
Functor)

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

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

instance Monad PurePrompt where
    return :: a -> PurePrompt a
return = a -> PurePrompt a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
    PurePrompt NonEmpty FilePath -> Either BreakException (a, NonEmpty FilePath)
a >>= :: PurePrompt a -> (a -> PurePrompt b) -> PurePrompt b
>>= a -> PurePrompt b
k = (NonEmpty FilePath -> Either BreakException (b, NonEmpty FilePath))
-> PurePrompt b
forall a.
(NonEmpty FilePath -> Either BreakException (a, NonEmpty FilePath))
-> PurePrompt a
PurePrompt ((NonEmpty FilePath
  -> Either BreakException (b, NonEmpty FilePath))
 -> PurePrompt b)
-> (NonEmpty FilePath
    -> Either BreakException (b, NonEmpty FilePath))
-> PurePrompt b
forall a b. (a -> b) -> a -> b
$ \NonEmpty FilePath
s -> case NonEmpty FilePath -> Either BreakException (a, NonEmpty FilePath)
a NonEmpty FilePath
s of
      Left BreakException
e -> BreakException -> Either BreakException (b, NonEmpty FilePath)
forall a b. a -> Either a b
Left BreakException
e
      Right (a
a', NonEmpty FilePath
s') -> PurePrompt b
-> NonEmpty FilePath
-> Either BreakException (b, NonEmpty FilePath)
forall a.
PurePrompt a
-> NonEmpty FilePath
-> Either BreakException (a, NonEmpty FilePath)
_runPrompt (a -> PurePrompt b
k a
a') NonEmpty FilePath
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 FilePath
getLine = IO FilePath
P.getLine
    readFile :: FilePath -> IO FilePath
readFile = FilePath -> IO FilePath
P.readFile
    getCurrentDirectory :: IO FilePath
getCurrentDirectory = IO FilePath
P.getCurrentDirectory
    getHomeDirectory :: IO FilePath
getHomeDirectory = IO FilePath
P.getHomeDirectory
    getDirectoryContents :: FilePath -> IO [FilePath]
getDirectoryContents = FilePath -> IO [FilePath]
P.getDirectoryContents
    listDirectory :: FilePath -> IO [FilePath]
listDirectory = FilePath -> IO [FilePath]
P.listDirectory
    doesDirectoryExist :: FilePath -> IO Bool
doesDirectoryExist = FilePath -> IO Bool
P.doesDirectoryExist
    doesFileExist :: FilePath -> IO Bool
doesFileExist = FilePath -> IO Bool
P.doesFileExist
    canonicalizePathNoThrow :: FilePath -> IO FilePath
canonicalizePathNoThrow = FilePath -> IO FilePath
P.canonicalizePathNoThrow
    readProcessWithExitCode :: FilePath
-> [FilePath] -> FilePath -> IO (ExitCode, FilePath, FilePath)
readProcessWithExitCode = FilePath
-> [FilePath] -> FilePath -> IO (ExitCode, FilePath, FilePath)
P.readProcessWithExitCode
    getEnvironment :: IO [(FilePath, FilePath)]
getEnvironment = IO [(FilePath, FilePath)]
P.getEnvironment
    getCurrentYear :: IO Integer
getCurrentYear = IO Integer
P.getCurrentYear
    listFilesInside :: (FilePath -> IO Bool) -> FilePath -> IO [FilePath]
listFilesInside = (FilePath -> IO Bool) -> FilePath -> IO [FilePath]
P.listFilesInside
    listFilesRecursive :: FilePath -> IO [FilePath]
listFilesRecursive = FilePath -> IO [FilePath]
P.listFilesRecursive

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

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

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

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

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

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

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

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

checkInvalidPath :: String -> a -> PurePrompt a
checkInvalidPath :: FilePath -> a -> PurePrompt a
checkInvalidPath FilePath
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 FilePath
path FilePath -> [FilePath] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [FilePath
"."] then
      BreakException -> PurePrompt a
forall (m :: * -> *) a. Interactive m => BreakException -> m a
throwPrompt (BreakException -> PurePrompt a) -> BreakException -> PurePrompt a
forall a b. (a -> b) -> a -> b
$ FilePath -> BreakException
BreakException (FilePath -> BreakException) -> FilePath -> BreakException
forall a b. (a -> b) -> a -> b
$ FilePath
"Invalid path: " FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
path
    else
      a -> PurePrompt a
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
(BreakException -> BreakException -> Bool)
-> (BreakException -> BreakException -> Bool) -> Eq BreakException
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 -> FilePath
(Int -> BreakException -> ShowS)
-> (BreakException -> FilePath)
-> ([BreakException] -> ShowS)
-> Show BreakException
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [BreakException] -> ShowS
$cshowList :: [BreakException] -> ShowS
show :: BreakException -> FilePath
$cshow :: BreakException -> FilePath
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
(Severity -> Severity -> Bool)
-> (Severity -> Severity -> Bool) -> Eq Severity
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 -> FilePath
(Int -> Severity -> ShowS)
-> (Severity -> FilePath) -> ([Severity] -> ShowS) -> Show Severity
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [Severity] -> ShowS
$cshowList :: [Severity] -> ShowS
show :: Severity -> FilePath
$cshow :: Severity -> FilePath
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
(DefaultPrompt t -> DefaultPrompt t -> Bool)
-> (DefaultPrompt t -> DefaultPrompt t -> Bool)
-> Eq (DefaultPrompt t)
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, a -> DefaultPrompt b -> DefaultPrompt a
(a -> b) -> DefaultPrompt a -> DefaultPrompt b
(forall a b. (a -> b) -> DefaultPrompt a -> DefaultPrompt b)
-> (forall a b. a -> DefaultPrompt b -> DefaultPrompt a)
-> Functor DefaultPrompt
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
<$ :: a -> DefaultPrompt b -> DefaultPrompt a
$c<$ :: forall a b. a -> DefaultPrompt b -> DefaultPrompt a
fmap :: (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.
  }