{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE TypeApplications #-}
module Distribution.Client.Init.Types
(
InitFlags (..)
, PkgDescription (..)
, LibTarget (..)
, ExeTarget (..)
, TestTarget (..)
, PackageType (..)
, HsFilePath (..)
, HsFileType (..)
, fromHsFilePath
, toHsFilePath
, toLiterateHs
, toStandardHs
, mkLiterate
, isHsFilePath
, Interactive (..)
, BreakException (..)
, PromptIO
, runPromptIO
, Inputs
, PurePrompt
, runPrompt
, evalPrompt
, Severity (..)
, IsLiterate
, IsSimple
, WriteOpts (..)
, ProjectSettings (..)
, FieldAnnotation (..)
, DefaultPrompt (..)
) where
import Distribution.Client.Compat.Prelude as P hiding (getLine, putStr, putStrLn)
import qualified Distribution.Client.Compat.Prelude as P
import Prelude (read)
import Control.Monad.Catch
import Control.Monad.IO.Class
import Control.Monad.Reader
import Data.List.NonEmpty (fromList)
import qualified Data.IORef
import Distribution.CabalSpecVersion
import Distribution.Client.Utils as P
import Distribution.Fields.Pretty
import Distribution.ModuleName
import qualified Distribution.Package as P
import Distribution.Simple.Setup (Flag (..))
import Distribution.Verbosity (silent)
import Distribution.Version
import Language.Haskell.Extension (Extension, Language (..))
import qualified System.IO
import qualified Distribution.Compat.Environment as P
import Distribution.FieldGrammar.Newtypes (SpecLicense)
import qualified System.Directory as P
import System.FilePath
import qualified System.Process as Process
data InitFlags = InitFlags
{ InitFlags -> Flag Bool
interactive :: Flag Bool
, InitFlags -> Flag Bool
quiet :: Flag Bool
, InitFlags -> Flag String
packageDir :: Flag FilePath
, :: 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
, :: Flag [String]
, :: 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
(InitFlags -> InitFlags -> Bool)
-> (InitFlags -> InitFlags -> Bool) -> Eq InitFlags
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: InitFlags -> InitFlags -> Bool
== :: InitFlags -> InitFlags -> Bool
$c/= :: InitFlags -> InitFlags -> Bool
/= :: InitFlags -> InitFlags -> Bool
Eq, Int -> InitFlags -> ShowS
[InitFlags] -> ShowS
InitFlags -> String
(Int -> InitFlags -> ShowS)
-> (InitFlags -> String)
-> ([InitFlags] -> ShowS)
-> Show InitFlags
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> InitFlags -> ShowS
showsPrec :: Int -> InitFlags -> ShowS
$cshow :: InitFlags -> String
show :: InitFlags -> String
$cshowList :: [InitFlags] -> ShowS
showList :: [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
$cfrom :: forall x. InitFlags -> Rep InitFlags x
from :: forall x. InitFlags -> Rep InitFlags x
$cto :: forall x. Rep InitFlags x -> InitFlags
to :: forall x. Rep InitFlags x -> InitFlags
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
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
, :: Set String
, :: Maybe (Set String)
}
deriving (Int -> PkgDescription -> ShowS
[PkgDescription] -> ShowS
PkgDescription -> String
(Int -> PkgDescription -> ShowS)
-> (PkgDescription -> String)
-> ([PkgDescription] -> ShowS)
-> Show PkgDescription
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PkgDescription -> ShowS
showsPrec :: Int -> PkgDescription -> ShowS
$cshow :: PkgDescription -> String
show :: PkgDescription -> String
$cshowList :: [PkgDescription] -> ShowS
showList :: [PkgDescription] -> ShowS
Show, PkgDescription -> PkgDescription -> Bool
(PkgDescription -> PkgDescription -> Bool)
-> (PkgDescription -> PkgDescription -> Bool) -> Eq PkgDescription
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PkgDescription -> PkgDescription -> Bool
== :: PkgDescription -> PkgDescription -> Bool
$c/= :: PkgDescription -> PkgDescription -> Bool
/= :: PkgDescription -> PkgDescription -> Bool
Eq)
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
(Int -> LibTarget -> ShowS)
-> (LibTarget -> String)
-> ([LibTarget] -> ShowS)
-> Show LibTarget
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> LibTarget -> ShowS
showsPrec :: Int -> LibTarget -> ShowS
$cshow :: LibTarget -> String
show :: LibTarget -> String
$cshowList :: [LibTarget] -> ShowS
showList :: [LibTarget] -> ShowS
Show, LibTarget -> LibTarget -> Bool
(LibTarget -> LibTarget -> Bool)
-> (LibTarget -> LibTarget -> Bool) -> Eq LibTarget
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: LibTarget -> LibTarget -> Bool
== :: LibTarget -> LibTarget -> Bool
$c/= :: LibTarget -> LibTarget -> Bool
/= :: LibTarget -> LibTarget -> Bool
Eq)
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
(Int -> ExeTarget -> ShowS)
-> (ExeTarget -> String)
-> ([ExeTarget] -> ShowS)
-> Show ExeTarget
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ExeTarget -> ShowS
showsPrec :: Int -> ExeTarget -> ShowS
$cshow :: ExeTarget -> String
show :: ExeTarget -> String
$cshowList :: [ExeTarget] -> ShowS
showList :: [ExeTarget] -> ShowS
Show, ExeTarget -> ExeTarget -> Bool
(ExeTarget -> ExeTarget -> Bool)
-> (ExeTarget -> ExeTarget -> Bool) -> Eq ExeTarget
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ExeTarget -> ExeTarget -> Bool
== :: ExeTarget -> ExeTarget -> Bool
$c/= :: ExeTarget -> ExeTarget -> Bool
/= :: ExeTarget -> ExeTarget -> Bool
Eq)
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
(Int -> TestTarget -> ShowS)
-> (TestTarget -> String)
-> ([TestTarget] -> ShowS)
-> Show TestTarget
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TestTarget -> ShowS
showsPrec :: Int -> TestTarget -> ShowS
$cshow :: TestTarget -> String
show :: TestTarget -> String
$cshowList :: [TestTarget] -> ShowS
showList :: [TestTarget] -> ShowS
Show, TestTarget -> TestTarget -> Bool
(TestTarget -> TestTarget -> Bool)
-> (TestTarget -> TestTarget -> Bool) -> Eq TestTarget
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TestTarget -> TestTarget -> Bool
== :: TestTarget -> TestTarget -> Bool
$c/= :: TestTarget -> TestTarget -> Bool
/= :: TestTarget -> TestTarget -> Bool
Eq)
data WriteOpts = WriteOpts
{ WriteOpts -> Bool
_optOverwrite :: Bool
, WriteOpts -> Bool
_optMinimal :: Bool
, :: 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
(WriteOpts -> WriteOpts -> Bool)
-> (WriteOpts -> WriteOpts -> Bool) -> Eq WriteOpts
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: WriteOpts -> WriteOpts -> Bool
== :: WriteOpts -> WriteOpts -> Bool
$c/= :: WriteOpts -> WriteOpts -> Bool
/= :: WriteOpts -> WriteOpts -> Bool
Eq, Int -> WriteOpts -> ShowS
[WriteOpts] -> ShowS
WriteOpts -> String
(Int -> WriteOpts -> ShowS)
-> (WriteOpts -> String)
-> ([WriteOpts] -> ShowS)
-> Show WriteOpts
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> WriteOpts -> ShowS
showsPrec :: Int -> WriteOpts -> ShowS
$cshow :: WriteOpts -> String
show :: WriteOpts -> String
$cshowList :: [WriteOpts] -> ShowS
showList :: [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
$c== :: ProjectSettings -> ProjectSettings -> Bool
== :: ProjectSettings -> ProjectSettings -> Bool
$c/= :: ProjectSettings -> ProjectSettings -> Bool
/= :: ProjectSettings -> ProjectSettings -> Bool
Eq, Int -> ProjectSettings -> ShowS
[ProjectSettings] -> ShowS
ProjectSettings -> String
(Int -> ProjectSettings -> ShowS)
-> (ProjectSettings -> String)
-> ([ProjectSettings] -> ShowS)
-> Show ProjectSettings
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ProjectSettings -> ShowS
showsPrec :: Int -> ProjectSettings -> ShowS
$cshow :: ProjectSettings -> String
show :: ProjectSettings -> String
$cshowList :: [ProjectSettings] -> ShowS
showList :: [ProjectSettings] -> ShowS
Show)
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
$c== :: PackageType -> PackageType -> Bool
== :: PackageType -> PackageType -> Bool
$c/= :: PackageType -> PackageType -> Bool
/= :: PackageType -> PackageType -> Bool
Eq, Int -> PackageType -> ShowS
[PackageType] -> ShowS
PackageType -> String
(Int -> PackageType -> ShowS)
-> (PackageType -> String)
-> ([PackageType] -> ShowS)
-> Show PackageType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PackageType -> ShowS
showsPrec :: Int -> PackageType -> ShowS
$cshow :: PackageType -> String
show :: PackageType -> String
$cshowList :: [PackageType] -> ShowS
showList :: [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
$cfrom :: forall x. PackageType -> Rep PackageType x
from :: forall x. PackageType -> Rep PackageType x
$cto :: forall x. Rep PackageType x -> PackageType
to :: forall x. Rep PackageType x -> PackageType
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
$c== :: HsFileType -> HsFileType -> Bool
== :: HsFileType -> HsFileType -> Bool
$c/= :: HsFileType -> HsFileType -> Bool
/= :: HsFileType -> HsFileType -> Bool
Eq, Int -> HsFileType -> ShowS
[HsFileType] -> ShowS
HsFileType -> String
(Int -> HsFileType -> ShowS)
-> (HsFileType -> String)
-> ([HsFileType] -> ShowS)
-> Show HsFileType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> HsFileType -> ShowS
showsPrec :: Int -> HsFileType -> ShowS
$cshow :: HsFileType -> String
show :: HsFileType -> String
$cshowList :: [HsFileType] -> ShowS
showList :: [HsFileType] -> ShowS
Show)
data HsFilePath = HsFilePath
{ HsFilePath -> String
_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
$c== :: HsFilePath -> HsFilePath -> Bool
== :: HsFilePath -> HsFilePath -> Bool
$c/= :: HsFilePath -> HsFilePath -> Bool
/= :: 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: " String -> ShowS
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 -> String -> Maybe String
forall a. a -> Maybe a
Just String
fp
HsFileType
Standard -> String -> Maybe String
forall a. a -> Maybe a
Just String
fp
HsFileType
InvalidHsPath -> Maybe String
forall a. Maybe a
Nothing
isHsFilePath :: FilePath -> Bool
isHsFilePath :: String -> Bool
isHsFilePath String
fp = case HsFilePath -> HsFileType
_hsFileType (HsFilePath -> HsFileType) -> HsFilePath -> 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 String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
".lhs" = String -> HsFileType -> HsFilePath
HsFilePath String
fp HsFileType
Literate
| ShowS
takeExtension String
fp String -> String -> Bool
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 String -> ShowS
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 String -> ShowS
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 String -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
line then String
line else String
"> " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
line) ShowS -> [String] -> [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [String]
hs
mkLiterate HsFilePath
_ [String]
hs = [String]
hs
newtype PromptIO a = PromptIO (ReaderT (Data.IORef.IORef SessionState) IO a)
deriving ((forall a b. (a -> b) -> PromptIO a -> PromptIO b)
-> (forall a b. a -> PromptIO b -> PromptIO a) -> Functor PromptIO
forall a b. a -> PromptIO b -> PromptIO a
forall a b. (a -> b) -> PromptIO a -> PromptIO b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> PromptIO a -> PromptIO b
fmap :: forall a b. (a -> b) -> PromptIO a -> PromptIO b
$c<$ :: forall a b. a -> PromptIO b -> PromptIO a
<$ :: forall a b. a -> PromptIO b -> PromptIO a
Functor, Functor PromptIO
Functor PromptIO =>
(forall a. a -> PromptIO a)
-> (forall a b. PromptIO (a -> b) -> PromptIO a -> PromptIO b)
-> (forall a b c.
(a -> b -> c) -> PromptIO a -> PromptIO b -> PromptIO c)
-> (forall a b. PromptIO a -> PromptIO b -> PromptIO b)
-> (forall a b. PromptIO a -> PromptIO b -> PromptIO a)
-> Applicative PromptIO
forall a. a -> PromptIO a
forall a b. PromptIO a -> PromptIO b -> PromptIO a
forall a b. PromptIO a -> PromptIO b -> PromptIO b
forall a b. PromptIO (a -> b) -> PromptIO a -> PromptIO b
forall a b c.
(a -> b -> c) -> PromptIO a -> PromptIO b -> PromptIO c
forall (f :: * -> *).
Functor f =>
(forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
$cpure :: forall a. a -> PromptIO a
pure :: forall a. a -> PromptIO a
$c<*> :: forall a b. PromptIO (a -> b) -> PromptIO a -> PromptIO b
<*> :: forall a b. PromptIO (a -> b) -> PromptIO a -> PromptIO b
$cliftA2 :: forall a b c.
(a -> b -> c) -> PromptIO a -> PromptIO b -> PromptIO c
liftA2 :: forall a b c.
(a -> b -> c) -> PromptIO a -> PromptIO b -> PromptIO c
$c*> :: forall a b. PromptIO a -> PromptIO b -> PromptIO b
*> :: forall a b. PromptIO a -> PromptIO b -> PromptIO b
$c<* :: forall a b. PromptIO a -> PromptIO b -> PromptIO a
<* :: forall a b. PromptIO a -> PromptIO b -> PromptIO a
Applicative, Applicative PromptIO
Applicative PromptIO =>
(forall a b. PromptIO a -> (a -> PromptIO b) -> PromptIO b)
-> (forall a b. PromptIO a -> PromptIO b -> PromptIO b)
-> (forall a. a -> PromptIO a)
-> Monad PromptIO
forall a. a -> PromptIO a
forall a b. PromptIO a -> PromptIO b -> PromptIO b
forall a b. PromptIO a -> (a -> PromptIO b) -> PromptIO b
forall (m :: * -> *).
Applicative m =>
(forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
$c>>= :: forall a b. PromptIO a -> (a -> PromptIO b) -> PromptIO b
>>= :: forall a b. PromptIO a -> (a -> PromptIO b) -> PromptIO b
$c>> :: forall a b. PromptIO a -> PromptIO b -> PromptIO b
>> :: forall a b. PromptIO a -> PromptIO b -> PromptIO b
$creturn :: forall a. a -> PromptIO a
return :: forall a. a -> PromptIO a
Monad, Monad PromptIO
Monad PromptIO =>
(forall a. IO a -> PromptIO a) -> MonadIO PromptIO
forall a. IO a -> PromptIO a
forall (m :: * -> *).
Monad m =>
(forall a. IO a -> m a) -> MonadIO m
$cliftIO :: forall a. IO a -> PromptIO a
liftIO :: forall a. IO a -> PromptIO a
MonadIO)
sessionState :: PromptIO (Data.IORef.IORef SessionState)
sessionState :: PromptIO (IORef SessionState)
sessionState = ReaderT (IORef SessionState) IO (IORef SessionState)
-> PromptIO (IORef SessionState)
forall a. ReaderT (IORef SessionState) IO a -> PromptIO a
PromptIO ReaderT (IORef SessionState) IO (IORef SessionState)
forall r (m :: * -> *). MonadReader r m => m r
ask
runPromptIO :: PromptIO a -> IO a
runPromptIO :: forall a. PromptIO a -> IO a
runPromptIO (PromptIO ReaderT (IORef SessionState) IO a
pio) =
(SessionState -> IO (IORef SessionState)
forall a. a -> IO (IORef a)
Data.IORef.newIORef SessionState
newSessionState) IO (IORef SessionState) -> (IORef SessionState -> IO a) -> IO a
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (ReaderT (IORef SessionState) IO a -> IORef SessionState -> IO a
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT ReaderT (IORef SessionState) IO a
pio)
type Inputs = NonEmpty String
newtype PurePrompt a = PurePrompt
{ forall a.
PurePrompt a
-> (Inputs, SessionState)
-> Either BreakException (a, (Inputs, SessionState))
runPromptState
:: (Inputs, SessionState)
-> Either BreakException (a, (Inputs, SessionState))
}
deriving ((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
$cfmap :: forall a b. (a -> b) -> PurePrompt a -> PurePrompt b
fmap :: forall a b. (a -> b) -> PurePrompt a -> PurePrompt b
$c<$ :: forall a b. a -> PurePrompt b -> PurePrompt a
<$ :: forall a b. a -> PurePrompt b -> PurePrompt a
Functor)
runPrompt :: PurePrompt a -> Inputs -> Either BreakException (a, Inputs)
runPrompt :: forall a.
PurePrompt a -> Inputs -> Either BreakException (a, Inputs)
runPrompt PurePrompt a
act Inputs
args =
((a, (Inputs, SessionState)) -> (a, Inputs))
-> Either BreakException (a, (Inputs, SessionState))
-> Either BreakException (a, Inputs)
forall a b.
(a -> b) -> Either BreakException a -> Either BreakException b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
(\(a
a, (Inputs
s, SessionState
_)) -> (a
a, Inputs
s))
(PurePrompt a
-> (Inputs, SessionState)
-> Either BreakException (a, (Inputs, SessionState))
forall a.
PurePrompt a
-> (Inputs, SessionState)
-> Either BreakException (a, (Inputs, SessionState))
runPromptState PurePrompt a
act (Inputs
args, SessionState
newSessionState))
evalPrompt :: PurePrompt a -> Inputs -> a
evalPrompt :: forall a. PurePrompt a -> Inputs -> a
evalPrompt PurePrompt a
act Inputs
s = case PurePrompt a -> Inputs -> Either BreakException (a, Inputs)
forall a.
PurePrompt a -> Inputs -> Either BreakException (a, Inputs)
runPrompt PurePrompt a
act Inputs
s of
Left BreakException
e -> String -> a
forall a. HasCallStack => String -> a
error (String -> a) -> String -> a
forall a b. (a -> b) -> a -> b
$ BreakException -> String
forall a. Show a => a -> String
show BreakException
e
Right (a
a, Inputs
_) -> a
a
instance Applicative PurePrompt where
pure :: forall a. a -> PurePrompt a
pure a
a = ((Inputs, SessionState)
-> Either BreakException (a, (Inputs, SessionState)))
-> PurePrompt a
forall a.
((Inputs, SessionState)
-> Either BreakException (a, (Inputs, SessionState)))
-> PurePrompt a
PurePrompt (((Inputs, SessionState)
-> Either BreakException (a, (Inputs, SessionState)))
-> PurePrompt a)
-> ((Inputs, SessionState)
-> Either BreakException (a, (Inputs, SessionState)))
-> PurePrompt a
forall a b. (a -> b) -> a -> b
$ \(Inputs, SessionState)
s -> (a, (Inputs, SessionState))
-> Either BreakException (a, (Inputs, SessionState))
forall a b. b -> Either a b
Right (a
a, (Inputs, SessionState)
s)
PurePrompt (Inputs, SessionState)
-> Either BreakException (a -> b, (Inputs, SessionState))
ff <*> :: forall a b. PurePrompt (a -> b) -> PurePrompt a -> PurePrompt b
<*> PurePrompt (Inputs, SessionState)
-> Either BreakException (a, (Inputs, SessionState))
aa = ((Inputs, SessionState)
-> Either BreakException (b, (Inputs, SessionState)))
-> PurePrompt b
forall a.
((Inputs, SessionState)
-> Either BreakException (a, (Inputs, SessionState)))
-> PurePrompt a
PurePrompt (((Inputs, SessionState)
-> Either BreakException (b, (Inputs, SessionState)))
-> PurePrompt b)
-> ((Inputs, SessionState)
-> Either BreakException (b, (Inputs, SessionState)))
-> PurePrompt b
forall a b. (a -> b) -> a -> b
$ \(Inputs, SessionState)
s -> case (Inputs, SessionState)
-> Either BreakException (a -> b, (Inputs, SessionState))
ff (Inputs, SessionState)
s of
Left BreakException
e -> BreakException -> Either BreakException (b, (Inputs, SessionState))
forall a b. a -> Either a b
Left BreakException
e
Right (a -> b
f, (Inputs, SessionState)
s') -> case (Inputs, SessionState)
-> Either BreakException (a, (Inputs, SessionState))
aa (Inputs, SessionState)
s' of
Left BreakException
e -> BreakException -> Either BreakException (b, (Inputs, SessionState))
forall a b. a -> Either a b
Left BreakException
e
Right (a
a, (Inputs, SessionState)
s'') -> (b, (Inputs, SessionState))
-> Either BreakException (b, (Inputs, SessionState))
forall a b. b -> Either a b
Right (a -> b
f a
a, (Inputs, SessionState)
s'')
instance Monad PurePrompt where
return :: forall a. a -> PurePrompt a
return = a -> PurePrompt a
forall a. a -> PurePrompt a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
PurePrompt (Inputs, SessionState)
-> Either BreakException (a, (Inputs, SessionState))
a >>= :: forall a b. PurePrompt a -> (a -> PurePrompt b) -> PurePrompt b
>>= a -> PurePrompt b
k = ((Inputs, SessionState)
-> Either BreakException (b, (Inputs, SessionState)))
-> PurePrompt b
forall a.
((Inputs, SessionState)
-> Either BreakException (a, (Inputs, SessionState)))
-> PurePrompt a
PurePrompt (((Inputs, SessionState)
-> Either BreakException (b, (Inputs, SessionState)))
-> PurePrompt b)
-> ((Inputs, SessionState)
-> Either BreakException (b, (Inputs, SessionState)))
-> PurePrompt b
forall a b. (a -> b) -> a -> b
$ \(Inputs, SessionState)
s -> case (Inputs, SessionState)
-> Either BreakException (a, (Inputs, SessionState))
a (Inputs, SessionState)
s of
Left BreakException
e -> BreakException -> Either BreakException (b, (Inputs, SessionState))
forall a b. a -> Either a b
Left BreakException
e
Right (a
a', (Inputs, SessionState)
s') -> PurePrompt b
-> (Inputs, SessionState)
-> Either BreakException (b, (Inputs, SessionState))
forall a.
PurePrompt a
-> (Inputs, SessionState)
-> Either BreakException (a, (Inputs, SessionState))
runPromptState (a -> PurePrompt b
k a
a') (Inputs, SessionState)
s'
class Monad m => Interactive m where
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)
maybeReadProcessWithExitCode :: FilePath -> [String] -> String -> m (Maybe (ExitCode, String, String))
getEnvironment :: m [(String, String)]
getCurrentYear :: m Integer
listFilesInside :: (FilePath -> m Bool) -> FilePath -> m [FilePath]
listFilesRecursive :: FilePath -> m [FilePath]
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 ()
break :: m Bool
throwPrompt :: BreakException -> m a
getLastChosenLanguage :: m (Maybe String)
setLastChosenLanguage :: (Maybe String) -> m ()
newtype SessionState = SessionState
{ SessionState -> Maybe String
lastChosenLanguage :: (Maybe String)
}
newSessionState :: SessionState
newSessionState :: SessionState
newSessionState = SessionState{lastChosenLanguage :: Maybe String
lastChosenLanguage = Maybe String
forall a. Maybe a
Nothing}
instance Interactive PromptIO where
getLine :: PromptIO String
getLine = IO String -> PromptIO String
forall a. IO a -> PromptIO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO String
P.getLine
readFile :: String -> PromptIO String
readFile = IO String -> PromptIO String
forall a. IO a -> PromptIO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO String -> PromptIO String)
-> (String -> IO String) -> String -> PromptIO String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> IO String
P.readFile
getCurrentDirectory :: PromptIO String
getCurrentDirectory = IO String -> PromptIO String
forall a. IO a -> PromptIO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO String
P.getCurrentDirectory
getHomeDirectory :: PromptIO String
getHomeDirectory = IO String -> PromptIO String
forall a. IO a -> PromptIO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO String
P.getHomeDirectory
getDirectoryContents :: String -> PromptIO [String]
getDirectoryContents = IO [String] -> PromptIO [String]
forall a. IO a -> PromptIO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [String] -> PromptIO [String])
-> (String -> IO [String]) -> String -> PromptIO [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> IO [String]
P.getDirectoryContents
listDirectory :: String -> PromptIO [String]
listDirectory = IO [String] -> PromptIO [String]
forall a. IO a -> PromptIO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [String] -> PromptIO [String])
-> (String -> IO [String]) -> String -> PromptIO [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> IO [String]
P.listDirectory
doesDirectoryExist :: String -> PromptIO Bool
doesDirectoryExist = IO Bool -> PromptIO Bool
forall a. IO a -> PromptIO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> PromptIO Bool)
-> (String -> IO Bool) -> String -> PromptIO Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> IO Bool
P.doesDirectoryExist
doesFileExist :: String -> PromptIO Bool
doesFileExist = IO Bool -> PromptIO Bool
forall a. IO a -> PromptIO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> PromptIO Bool)
-> (String -> IO Bool) -> String -> PromptIO Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> IO Bool
P.doesFileExist
canonicalizePathNoThrow :: String -> PromptIO String
canonicalizePathNoThrow = IO String -> PromptIO String
forall a. IO a -> PromptIO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO String -> PromptIO String)
-> (String -> IO String) -> String -> PromptIO String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> IO String
P.canonicalizePathNoThrow
readProcessWithExitCode :: String -> [String] -> String -> PromptIO (ExitCode, String, String)
readProcessWithExitCode String
a [String]
b String
c = IO (ExitCode, String, String)
-> PromptIO (ExitCode, String, String)
forall a. IO a -> PromptIO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (ExitCode, String, String)
-> PromptIO (ExitCode, String, String))
-> IO (ExitCode, String, String)
-> PromptIO (ExitCode, String, String)
forall a b. (a -> b) -> a -> b
$ String -> [String] -> String -> IO (ExitCode, String, String)
Process.readProcessWithExitCode String
a [String]
b String
c
maybeReadProcessWithExitCode :: String
-> [String]
-> String
-> PromptIO (Maybe (ExitCode, String, String))
maybeReadProcessWithExitCode String
a [String]
b String
c = IO (Maybe (ExitCode, String, String))
-> PromptIO (Maybe (ExitCode, String, String))
forall a. IO a -> PromptIO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe (ExitCode, String, String))
-> PromptIO (Maybe (ExitCode, String, String)))
-> IO (Maybe (ExitCode, String, String))
-> PromptIO (Maybe (ExitCode, String, String))
forall a b. (a -> b) -> a -> b
$ ((ExitCode, String, String) -> Maybe (ExitCode, String, String)
forall a. a -> Maybe a
Just ((ExitCode, String, String) -> Maybe (ExitCode, String, String))
-> IO (ExitCode, String, String)
-> IO (Maybe (ExitCode, String, String))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> [String] -> String -> IO (ExitCode, String, String)
Process.readProcessWithExitCode String
a [String]
b String
c) IO (Maybe (ExitCode, String, String))
-> (IOError -> IO (Maybe (ExitCode, String, String)))
-> IO (Maybe (ExitCode, String, String))
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`P.catch` forall a b. a -> b -> a
const @_ @IOError (Maybe (ExitCode, String, String)
-> IO (Maybe (ExitCode, String, String))
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (ExitCode, String, String)
forall a. Maybe a
Nothing)
getEnvironment :: PromptIO [(String, String)]
getEnvironment = IO [(String, String)] -> PromptIO [(String, String)]
forall a. IO a -> PromptIO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO [(String, String)]
P.getEnvironment
getCurrentYear :: PromptIO Integer
getCurrentYear = IO Integer -> PromptIO Integer
forall a. IO a -> PromptIO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO Integer
P.getCurrentYear
listFilesInside :: (String -> PromptIO Bool) -> String -> PromptIO [String]
listFilesInside String -> PromptIO Bool
test String
dir = do
IO [String] -> PromptIO [String]
forall a. IO a -> PromptIO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [String] -> PromptIO [String])
-> IO [String] -> PromptIO [String]
forall a b. (a -> b) -> a -> b
$ (String -> IO Bool) -> String -> IO [String]
P.listFilesInside (\String
f -> IO Bool -> IO Bool
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> IO Bool) -> IO Bool -> IO Bool
forall a b. (a -> b) -> a -> b
$ PromptIO Bool -> IO Bool
forall a. PromptIO a -> IO a
runPromptIO (String -> PromptIO Bool
test String
f)) String
dir
listFilesRecursive :: String -> PromptIO [String]
listFilesRecursive = IO [String] -> PromptIO [String]
forall a. IO a -> PromptIO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [String] -> PromptIO [String])
-> (String -> IO [String]) -> String -> PromptIO [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> IO [String]
P.listFilesRecursive
putStr :: String -> PromptIO ()
putStr = IO () -> PromptIO ()
forall a. IO a -> PromptIO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> PromptIO ())
-> (String -> IO ()) -> String -> PromptIO ()
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> IO ()
P.putStr
putStrLn :: String -> PromptIO ()
putStrLn = IO () -> PromptIO ()
forall a. IO a -> PromptIO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> PromptIO ())
-> (String -> IO ()) -> String -> PromptIO ()
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> IO ()
P.putStrLn
createDirectory :: String -> PromptIO ()
createDirectory = IO () -> PromptIO ()
forall a. IO a -> PromptIO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> PromptIO ())
-> (String -> IO ()) -> String -> PromptIO ()
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> IO ()
P.createDirectory
removeDirectory :: String -> PromptIO ()
removeDirectory = IO () -> PromptIO ()
forall a. IO a -> PromptIO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> PromptIO ())
-> (String -> IO ()) -> String -> PromptIO ()
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> IO ()
P.removeDirectoryRecursive
writeFile :: String -> String -> PromptIO ()
writeFile String
a String
b = IO () -> PromptIO ()
forall a. IO a -> PromptIO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> PromptIO ()) -> IO () -> PromptIO ()
forall a b. (a -> b) -> a -> b
$ String -> String -> IO ()
P.writeFile String
a String
b
removeExistingFile :: String -> PromptIO ()
removeExistingFile = IO () -> PromptIO ()
forall a. IO a -> PromptIO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> PromptIO ())
-> (String -> IO ()) -> String -> PromptIO ()
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> IO ()
P.removeExistingFile
copyFile :: String -> String -> PromptIO ()
copyFile String
a String
b = IO () -> PromptIO ()
forall a. IO a -> PromptIO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> PromptIO ()) -> IO () -> PromptIO ()
forall a b. (a -> b) -> a -> b
$ String -> String -> IO ()
P.copyFile String
a String
b
renameDirectory :: String -> String -> PromptIO ()
renameDirectory String
a String
b = IO () -> PromptIO ()
forall a. IO a -> PromptIO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> PromptIO ()) -> IO () -> PromptIO ()
forall a b. (a -> b) -> a -> b
$ String -> String -> IO ()
P.renameDirectory String
a String
b
hFlush :: Handle -> PromptIO ()
hFlush = IO () -> PromptIO ()
forall a. IO a -> PromptIO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> PromptIO ())
-> (Handle -> IO ()) -> Handle -> PromptIO ()
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Handle -> IO ()
System.IO.hFlush
message :: Verbosity -> Severity -> String -> PromptIO ()
message Verbosity
q Severity
severity String
msg
| Verbosity
q Verbosity -> Verbosity -> Bool
forall a. Eq a => a -> a -> Bool
== Verbosity
silent = () -> PromptIO ()
forall a. a -> PromptIO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
| Bool
otherwise = String -> PromptIO ()
forall (m :: * -> *). Interactive m => String -> m ()
putStrLn (String -> PromptIO ()) -> String -> PromptIO ()
forall a b. (a -> b) -> a -> b
$ String
"[" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Severity -> String
displaySeverity Severity
severity String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"] " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
msg
break :: PromptIO Bool
break = Bool -> PromptIO Bool
forall a. a -> PromptIO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
throwPrompt :: forall a. BreakException -> PromptIO a
throwPrompt = IO a -> PromptIO a
forall a. IO a -> PromptIO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO a -> PromptIO a)
-> (BreakException -> IO a) -> BreakException -> PromptIO a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BreakException -> IO a
forall e a. (HasCallStack, Exception e) => e -> IO a
forall (m :: * -> *) e a.
(MonadThrow m, HasCallStack, Exception e) =>
e -> m a
throwM
getLastChosenLanguage :: PromptIO (Maybe String)
getLastChosenLanguage = do
IORef SessionState
stateRef <- PromptIO (IORef SessionState)
sessionState
IO (Maybe String) -> PromptIO (Maybe String)
forall a. IO a -> PromptIO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe String) -> PromptIO (Maybe String))
-> IO (Maybe String) -> PromptIO (Maybe String)
forall a b. (a -> b) -> a -> b
$ SessionState -> Maybe String
lastChosenLanguage (SessionState -> Maybe String)
-> IO SessionState -> IO (Maybe String)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IORef SessionState -> IO SessionState
forall a. IORef a -> IO a
Data.IORef.readIORef IORef SessionState
stateRef
setLastChosenLanguage :: Maybe String -> PromptIO ()
setLastChosenLanguage Maybe String
value = do
IORef SessionState
stateRef <- PromptIO (IORef SessionState)
sessionState
IO () -> PromptIO ()
forall a. IO a -> PromptIO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> PromptIO ()) -> IO () -> PromptIO ()
forall a b. (a -> b) -> a -> b
$
IORef SessionState -> (SessionState -> SessionState) -> IO ()
forall a. IORef a -> (a -> a) -> IO ()
Data.IORef.modifyIORef
IORef SessionState
stateRef
(\SessionState
state -> SessionState
state{lastChosenLanguage = value})
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
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
(ExitCode, String, String) -> PurePrompt (ExitCode, String, String)
forall a. a -> PurePrompt a
forall (m :: * -> *) a. Monad m => a -> m a
return (ExitCode
ExitSuccess, String
input, String
"")
maybeReadProcessWithExitCode :: String
-> [String]
-> String
-> PurePrompt (Maybe (ExitCode, String, String))
maybeReadProcessWithExitCode String
a [String]
b String
c = (ExitCode, String, String) -> Maybe (ExitCode, String, String)
forall a. a -> Maybe a
Just ((ExitCode, String, String) -> Maybe (ExitCode, String, String))
-> PurePrompt (ExitCode, String, String)
-> PurePrompt (Maybe (ExitCode, String, String))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String
-> [String] -> String -> PurePrompt (ExitCode, String, String)
forall (m :: * -> *).
Interactive m =>
String -> [String] -> String -> m (ExitCode, String, String)
readProcessWithExitCode String
a [String]
b String
c
getEnvironment :: PurePrompt [(String, String)]
getEnvironment = ([String] -> [(String, String)])
-> PurePrompt [String] -> PurePrompt [(String, String)]
forall a b. (a -> b) -> PurePrompt a -> PurePrompt b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((String -> (String, String)) -> [String] -> [(String, String)]
forall a b. (a -> b) -> [a] -> [b]
map String -> (String, String)
forall a. Read a => String -> a
read) PurePrompt [String]
popList
getCurrentYear :: PurePrompt Integer
getCurrentYear = (String -> Integer) -> PurePrompt String -> PurePrompt Integer
forall a b. (a -> b) -> PurePrompt a -> PurePrompt b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap String -> Integer
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 <- (String -> [String]) -> [String] -> [[String]]
forall a b. (a -> b) -> [a] -> [b]
map String -> [String]
splitDirectories ([String] -> [[String]])
-> PurePrompt [String] -> PurePrompt [[String]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> PurePrompt [String]
popList
([String] -> String) -> [[String]] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map [String] -> String
joinPath ([[String]] -> [String])
-> PurePrompt [[String]] -> PurePrompt [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ([String] -> PurePrompt Bool)
-> [[String]] -> PurePrompt [[String]]
forall (m :: * -> *) a.
Applicative m =>
(a -> m Bool) -> [a] -> m [a]
filterM (([Bool] -> Bool) -> PurePrompt [Bool] -> PurePrompt Bool
forall a b. (a -> b) -> PurePrompt a -> PurePrompt b
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)
-> ([String] -> PurePrompt [Bool]) -> [String] -> PurePrompt Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> PurePrompt Bool) -> [String] -> PurePrompt [Bool]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse String -> PurePrompt Bool
pred') [[String]]
input
listFilesRecursive :: String -> PurePrompt [String]
listFilesRecursive !String
_ = PurePrompt [String]
popList
putStr :: String -> PurePrompt ()
putStr !String
_ = () -> PurePrompt ()
forall a. a -> PurePrompt a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
putStrLn :: String -> PurePrompt ()
putStrLn !String
_ = () -> PurePrompt ()
forall a. a -> PurePrompt a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
createDirectory :: String -> PurePrompt ()
createDirectory !String
d = String -> () -> PurePrompt ()
forall a. String -> a -> PurePrompt a
checkInvalidPath String
d ()
removeDirectory :: String -> PurePrompt ()
removeDirectory !String
d = String -> () -> PurePrompt ()
forall a. String -> a -> PurePrompt a
checkInvalidPath String
d ()
writeFile :: String -> String -> PurePrompt ()
writeFile !String
f !String
_ = String -> () -> PurePrompt ()
forall a. String -> a -> PurePrompt a
checkInvalidPath String
f ()
removeExistingFile :: String -> PurePrompt ()
removeExistingFile !String
f = String -> () -> PurePrompt ()
forall a. String -> a -> PurePrompt a
checkInvalidPath String
f ()
copyFile :: String -> String -> PurePrompt ()
copyFile !String
f !String
_ = String -> () -> PurePrompt ()
forall a. String -> a -> PurePrompt a
checkInvalidPath String
f ()
renameDirectory :: String -> String -> PurePrompt ()
renameDirectory !String
d !String
_ = String -> () -> PurePrompt ()
forall a. String -> a -> PurePrompt a
checkInvalidPath String
d ()
hFlush :: Handle -> PurePrompt ()
hFlush Handle
_ = () -> PurePrompt ()
forall a. a -> PurePrompt a
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 -> ((Inputs, SessionState)
-> Either BreakException ((), (Inputs, SessionState)))
-> PurePrompt ()
forall a.
((Inputs, SessionState)
-> Either BreakException (a, (Inputs, SessionState)))
-> PurePrompt a
PurePrompt (((Inputs, SessionState)
-> Either BreakException ((), (Inputs, SessionState)))
-> PurePrompt ())
-> ((Inputs, SessionState)
-> Either BreakException ((), (Inputs, SessionState)))
-> PurePrompt ()
forall a b. (a -> b) -> a -> b
$ \(Inputs, SessionState)
_ ->
BreakException
-> Either BreakException ((), (Inputs, SessionState))
forall a b. a -> Either a b
Left (BreakException
-> Either BreakException ((), (Inputs, SessionState)))
-> BreakException
-> Either BreakException ((), (Inputs, SessionState))
forall a b. (a -> b) -> a -> b
$
String -> BreakException
BreakException
(Severity -> String
displaySeverity Severity
severity String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
": " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
msg)
Severity
_ -> () -> PurePrompt ()
forall a. a -> PurePrompt a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
break :: PurePrompt Bool
break = Bool -> PurePrompt Bool
forall a. a -> PurePrompt a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
throwPrompt :: forall a. BreakException -> PurePrompt a
throwPrompt (BreakException String
e) = ((Inputs, SessionState)
-> Either BreakException (a, (Inputs, SessionState)))
-> PurePrompt a
forall a.
((Inputs, SessionState)
-> Either BreakException (a, (Inputs, SessionState)))
-> PurePrompt a
PurePrompt (((Inputs, SessionState)
-> Either BreakException (a, (Inputs, SessionState)))
-> PurePrompt a)
-> ((Inputs, SessionState)
-> Either BreakException (a, (Inputs, SessionState)))
-> PurePrompt a
forall a b. (a -> b) -> a -> b
$ \(Inputs
i, SessionState
_) ->
BreakException -> Either BreakException (a, (Inputs, SessionState))
forall a b. a -> Either a b
Left (BreakException
-> Either BreakException (a, (Inputs, SessionState)))
-> BreakException
-> Either BreakException (a, (Inputs, SessionState))
forall a b. (a -> b) -> a -> b
$
String -> BreakException
BreakException
(String
"Error: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
e String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\nStacktrace: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Inputs -> String
forall a. Show a => a -> String
show Inputs
i)
getLastChosenLanguage :: PurePrompt (Maybe String)
getLastChosenLanguage = ((Inputs, SessionState)
-> Either BreakException (Maybe String, (Inputs, SessionState)))
-> PurePrompt (Maybe String)
forall a.
((Inputs, SessionState)
-> Either BreakException (a, (Inputs, SessionState)))
-> PurePrompt a
PurePrompt (((Inputs, SessionState)
-> Either BreakException (Maybe String, (Inputs, SessionState)))
-> PurePrompt (Maybe String))
-> ((Inputs, SessionState)
-> Either BreakException (Maybe String, (Inputs, SessionState)))
-> PurePrompt (Maybe String)
forall a b. (a -> b) -> a -> b
$ \(Inputs
i, SessionState
s) ->
(Maybe String, (Inputs, SessionState))
-> Either BreakException (Maybe String, (Inputs, SessionState))
forall a b. b -> Either a b
Right (SessionState -> Maybe String
lastChosenLanguage SessionState
s, (Inputs
i, SessionState
s))
setLastChosenLanguage :: Maybe String -> PurePrompt ()
setLastChosenLanguage Maybe String
l = ((Inputs, SessionState)
-> Either BreakException ((), (Inputs, SessionState)))
-> PurePrompt ()
forall a.
((Inputs, SessionState)
-> Either BreakException (a, (Inputs, SessionState)))
-> PurePrompt a
PurePrompt (((Inputs, SessionState)
-> Either BreakException ((), (Inputs, SessionState)))
-> PurePrompt ())
-> ((Inputs, SessionState)
-> Either BreakException ((), (Inputs, SessionState)))
-> PurePrompt ()
forall a b. (a -> b) -> a -> b
$ \(Inputs
i, SessionState
s) ->
((), (Inputs, SessionState))
-> Either BreakException ((), (Inputs, SessionState))
forall a b. b -> Either a b
Right ((), (Inputs
i, SessionState
s{lastChosenLanguage = l}))
pop :: PurePrompt String
pop :: PurePrompt String
pop = ((Inputs, SessionState)
-> Either BreakException (String, (Inputs, SessionState)))
-> PurePrompt String
forall a.
((Inputs, SessionState)
-> Either BreakException (a, (Inputs, SessionState)))
-> PurePrompt a
PurePrompt (((Inputs, SessionState)
-> Either BreakException (String, (Inputs, SessionState)))
-> PurePrompt String)
-> ((Inputs, SessionState)
-> Either BreakException (String, (Inputs, SessionState)))
-> PurePrompt String
forall a b. (a -> b) -> a -> b
$ \(String
i :| [String]
is, SessionState
s) -> (String, (Inputs, SessionState))
-> Either BreakException (String, (Inputs, SessionState))
forall a b. b -> Either a b
Right (String
i, ([String] -> Inputs
forall a. HasCallStack => [a] -> NonEmpty a
fromList [String]
is, SessionState
s))
popAbsolute :: PurePrompt String
popAbsolute :: PurePrompt String
popAbsolute = do
String
input <- PurePrompt String
pop
String -> PurePrompt String
forall a. a -> PurePrompt a
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> PurePrompt String) -> String -> PurePrompt String
forall a b. (a -> b) -> a -> b
$ String
"/home/test/" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
input
popBool :: PurePrompt Bool
popBool :: PurePrompt Bool
popBool =
PurePrompt String
pop PurePrompt String -> (String -> PurePrompt Bool) -> PurePrompt Bool
forall a b. PurePrompt a -> (a -> PurePrompt b) -> PurePrompt b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
String
"True" -> Bool -> PurePrompt Bool
forall a. a -> PurePrompt a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
True
String
"False" -> Bool -> PurePrompt Bool
forall a. a -> PurePrompt a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False
String
i -> BreakException -> PurePrompt Bool
forall a. BreakException -> PurePrompt a
forall (m :: * -> *) a. Interactive m => BreakException -> m a
throwPrompt (BreakException -> PurePrompt Bool)
-> BreakException -> PurePrompt Bool
forall a b. (a -> b) -> a -> b
$ String -> BreakException
BreakException (String -> BreakException) -> String -> BreakException
forall a b. (a -> b) -> a -> b
$ String
"popBool: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
i
popList :: PurePrompt [String]
popList :: PurePrompt [String]
popList =
PurePrompt String
pop PurePrompt String
-> (String -> PurePrompt [String]) -> PurePrompt [String]
forall a b. PurePrompt a -> (a -> PurePrompt b) -> PurePrompt b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \String
a -> case String -> Maybe [String]
forall a. Read a => String -> Maybe a
P.safeRead String
a of
Maybe [String]
Nothing -> BreakException -> PurePrompt [String]
forall a. BreakException -> PurePrompt a
forall (m :: * -> *) a. Interactive m => BreakException -> m a
throwPrompt (BreakException -> PurePrompt [String])
-> BreakException -> PurePrompt [String]
forall a b. (a -> b) -> a -> b
$ String -> BreakException
BreakException (String
"popList: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS
forall a. Show a => a -> String
show String
a)
Just [String]
as -> [String] -> PurePrompt [String]
forall a. a -> PurePrompt a
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 =
if String
path String -> [String] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String
"."]
then BreakException -> PurePrompt a
forall a. 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
$ String -> BreakException
BreakException (String -> BreakException) -> String -> BreakException
forall a b. (a -> b) -> a -> b
$ String
"Invalid path: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
path
else a -> PurePrompt a
forall a. a -> PurePrompt a
forall (m :: * -> *) a. Monad m => a -> m a
return a
act
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
$c== :: BreakException -> BreakException -> Bool
== :: BreakException -> BreakException -> Bool
$c/= :: BreakException -> BreakException -> Bool
/= :: BreakException -> BreakException -> Bool
Eq, Int -> BreakException -> ShowS
[BreakException] -> ShowS
BreakException -> String
(Int -> BreakException -> ShowS)
-> (BreakException -> String)
-> ([BreakException] -> ShowS)
-> Show BreakException
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> BreakException -> ShowS
showsPrec :: Int -> BreakException -> ShowS
$cshow :: BreakException -> String
show :: BreakException -> String
$cshowList :: [BreakException] -> ShowS
showList :: [BreakException] -> ShowS
Show)
instance Exception BreakException
data Severity = 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
$c== :: Severity -> Severity -> Bool
== :: Severity -> Severity -> Bool
$c/= :: Severity -> Severity -> Bool
/= :: Severity -> Severity -> Bool
Eq)
displaySeverity :: Severity -> String
displaySeverity :: Severity -> String
displaySeverity Severity
severity = case Severity
severity of
Severity
Info -> String
"Info"
Severity
Warning -> String
"Warn"
Severity
Error -> String
"Err"
type IsLiterate = Bool
type IsSimple = Bool
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
$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
/= :: DefaultPrompt t -> DefaultPrompt t -> Bool
Eq, (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
$cfmap :: forall a b. (a -> b) -> DefaultPrompt a -> DefaultPrompt b
fmap :: forall a b. (a -> b) -> DefaultPrompt a -> DefaultPrompt b
$c<$ :: forall a b. a -> DefaultPrompt b -> DefaultPrompt a
<$ :: forall a b. a -> DefaultPrompt b -> DefaultPrompt a
Functor)
data FieldAnnotation = FieldAnnotation
{ :: Bool
, :: CommentPosition
}