module Ribosome.App.ProjectOptions where import Ribosome.App.Data ( Cachix (Cachix), CachixKey, CachixName, Github (Github), GithubOrg, GithubRepo (GithubRepo), Project (..), ProjectName (ProjectName), ProjectNames, SkipCachix (SkipCachix), ) import Ribosome.App.Error (RainbowError, appError) import Ribosome.App.Options (ProjectOptions) import qualified Ribosome.App.ProjectNames as ProjectNames import Ribosome.App.ProjectPath (cwdProjectPath) import Ribosome.App.UserInput (askRequired, askUser) resolveName :: Members [Stop RainbowError, Embed IO] r => Sem r ProjectNames resolveName :: forall (r :: EffectRow). Members '[Stop RainbowError, Embed IO] r => Sem r ProjectNames resolveName = do String name <- Text -> Sem r String forall a (r :: EffectRow). (Eq a, IsString a, Members '[Stop RainbowError, Embed IO] r) => Text -> Sem r a askRequired Text "Name of the project?" (Chunk -> RainbowError) -> Either Chunk ProjectNames -> Sem r ProjectNames forall err' (r :: EffectRow) err a. Member (Stop err') r => (err -> err') -> Either err a -> Sem r a stopEitherWith Chunk -> RainbowError err (String -> Either Chunk ProjectNames forall err. IsString err => String -> Either err ProjectNames ProjectNames.parse String name) where err :: Chunk -> RainbowError err = [Chunk] -> RainbowError appError ([Chunk] -> RainbowError) -> (Chunk -> [Chunk]) -> Chunk -> RainbowError forall b c a. (b -> c) -> (a -> b) -> a -> c . Chunk -> [Chunk] forall (f :: * -> *) a. Applicative f => a -> f a pure askGithubRepo :: Members [Stop RainbowError, Embed IO] r => ProjectName -> Sem r GithubRepo askGithubRepo :: forall (r :: EffectRow). Members '[Stop RainbowError, Embed IO] r => ProjectName -> Sem r GithubRepo askGithubRepo (ProjectName Text name) = GithubRepo -> Maybe GithubRepo -> GithubRepo forall a. a -> Maybe a -> a fromMaybe (Text -> GithubRepo GithubRepo Text name) (Maybe GithubRepo -> GithubRepo) -> Sem r (Maybe GithubRepo) -> Sem r GithubRepo forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> Text -> Sem r (Maybe GithubRepo) forall a (r :: EffectRow). (Eq a, IsString a, Members '[Stop RainbowError, Embed IO] r) => Text -> Sem r (Maybe a) askUser Text "Github repository name? (Empty uses project name)" withOrg :: Members [Stop RainbowError, Embed IO] r => ProjectName -> Maybe GithubRepo -> GithubOrg -> Sem r Github withOrg :: forall (r :: EffectRow). Members '[Stop RainbowError, Embed IO] r => ProjectName -> Maybe GithubRepo -> GithubOrg -> Sem r Github withOrg ProjectName name Maybe GithubRepo repo GithubOrg org = GithubOrg -> GithubRepo -> Github Github GithubOrg org (GithubRepo -> Github) -> Sem r GithubRepo -> Sem r Github forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> Sem r GithubRepo -> (GithubRepo -> Sem r GithubRepo) -> Maybe GithubRepo -> Sem r GithubRepo forall b a. b -> (a -> b) -> Maybe a -> b maybe (ProjectName -> Sem r GithubRepo forall (r :: EffectRow). Members '[Stop RainbowError, Embed IO] r => ProjectName -> Sem r GithubRepo askGithubRepo ProjectName name) GithubRepo -> Sem r GithubRepo forall (f :: * -> *) a. Applicative f => a -> f a pure Maybe GithubRepo repo askGithub :: Members [Stop RainbowError, Embed IO] r => ProjectName -> Maybe GithubRepo -> Sem r (Maybe Github) askGithub :: forall (r :: EffectRow). Members '[Stop RainbowError, Embed IO] r => ProjectName -> Maybe GithubRepo -> Sem r (Maybe Github) askGithub ProjectName name Maybe GithubRepo repo = (GithubOrg -> Sem r Github) -> Maybe GithubOrg -> Sem r (Maybe Github) forall (t :: * -> *) (f :: * -> *) a b. (Traversable t, Applicative f) => (a -> f b) -> t a -> f (t b) traverse (ProjectName -> Maybe GithubRepo -> GithubOrg -> Sem r Github forall (r :: EffectRow). Members '[Stop RainbowError, Embed IO] r => ProjectName -> Maybe GithubRepo -> GithubOrg -> Sem r Github withOrg ProjectName name Maybe GithubRepo repo) (Maybe GithubOrg -> Sem r (Maybe Github)) -> Sem r (Maybe GithubOrg) -> Sem r (Maybe Github) forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b =<< Text -> Sem r (Maybe GithubOrg) forall a (r :: EffectRow). (Eq a, IsString a, Members '[Stop RainbowError, Embed IO] r) => Text -> Sem r (Maybe a) askUser Text "Github organization? (Empty skips Github)" withCachixName :: Members [Stop RainbowError, Embed IO] r => Maybe CachixKey -> CachixName -> Sem r Cachix withCachixName :: forall (r :: EffectRow). Members '[Stop RainbowError, Embed IO] r => Maybe CachixKey -> CachixName -> Sem r Cachix withCachixName Maybe CachixKey key CachixName name = CachixName -> CachixKey -> Cachix Cachix CachixName name (CachixKey -> Cachix) -> Sem r CachixKey -> Sem r Cachix forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> Sem r CachixKey -> (CachixKey -> Sem r CachixKey) -> Maybe CachixKey -> Sem r CachixKey forall b a. b -> (a -> b) -> Maybe a -> b maybe (Text -> Sem r CachixKey forall a (r :: EffectRow). (Eq a, IsString a, Members '[Stop RainbowError, Embed IO] r) => Text -> Sem r a askRequired Text "Cachix public key?") CachixKey -> Sem r CachixKey forall (f :: * -> *) a. Applicative f => a -> f a pure Maybe CachixKey key askCachix :: Members [Stop RainbowError, Embed IO] r => Maybe CachixKey -> Sem r (Maybe Cachix) askCachix :: forall (r :: EffectRow). Members '[Stop RainbowError, Embed IO] r => Maybe CachixKey -> Sem r (Maybe Cachix) askCachix Maybe CachixKey key = (CachixName -> Sem r Cachix) -> Maybe CachixName -> Sem r (Maybe Cachix) forall (t :: * -> *) (f :: * -> *) a b. (Traversable t, Applicative f) => (a -> f b) -> t a -> f (t b) traverse (Maybe CachixKey -> CachixName -> Sem r Cachix forall (r :: EffectRow). Members '[Stop RainbowError, Embed IO] r => Maybe CachixKey -> CachixName -> Sem r Cachix withCachixName Maybe CachixKey key) (Maybe CachixName -> Sem r (Maybe Cachix)) -> Sem r (Maybe CachixName) -> Sem r (Maybe Cachix) forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b =<< Text -> Sem r (Maybe CachixName) forall a (r :: EffectRow). (Eq a, IsString a, Members '[Stop RainbowError, Embed IO] r) => Text -> Sem r (Maybe a) askUser Text "Cachix name? (Empty skips Cachix, ignore if unclear)" cachixOption :: Members [Stop RainbowError, Embed IO] r => Maybe CachixKey -> Maybe CachixName -> SkipCachix -> Sem r (Maybe Cachix) cachixOption :: forall (r :: EffectRow). Members '[Stop RainbowError, Embed IO] r => Maybe CachixKey -> Maybe CachixName -> SkipCachix -> Sem r (Maybe Cachix) cachixOption Maybe CachixKey cachixKey Maybe CachixName cachixName = \case SkipCachix Bool True -> Maybe Cachix -> Sem r (Maybe Cachix) forall (f :: * -> *) a. Applicative f => a -> f a pure Maybe Cachix forall a. Maybe a Nothing SkipCachix Bool False -> Sem r (Maybe Cachix) -> (CachixName -> Sem r (Maybe Cachix)) -> Maybe CachixName -> Sem r (Maybe Cachix) forall b a. b -> (a -> b) -> Maybe a -> b maybe (Maybe CachixKey -> Sem r (Maybe Cachix) forall (r :: EffectRow). Members '[Stop RainbowError, Embed IO] r => Maybe CachixKey -> Sem r (Maybe Cachix) askCachix Maybe CachixKey cachixKey) ((Cachix -> Maybe Cachix) -> Sem r Cachix -> Sem r (Maybe Cachix) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b fmap Cachix -> Maybe Cachix forall a. a -> Maybe a Just (Sem r Cachix -> Sem r (Maybe Cachix)) -> (CachixName -> Sem r Cachix) -> CachixName -> Sem r (Maybe Cachix) forall b c a. (b -> c) -> (a -> b) -> a -> c . Maybe CachixKey -> CachixName -> Sem r Cachix forall (r :: EffectRow). Members '[Stop RainbowError, Embed IO] r => Maybe CachixKey -> CachixName -> Sem r Cachix withCachixName Maybe CachixKey cachixKey) Maybe CachixName cachixName projectOptions :: Members [Stop RainbowError, Embed IO] r => Bool -> ProjectOptions -> Sem r Project projectOptions :: forall (r :: EffectRow). Members '[Stop RainbowError, Embed IO] r => Bool -> ProjectOptions -> Sem r Project projectOptions Bool appendNameToCwd ProjectOptions opts = do ProjectNames names <- Sem r ProjectNames -> (ProjectNames -> Sem r ProjectNames) -> Maybe ProjectNames -> Sem r ProjectNames forall b a. b -> (a -> b) -> Maybe a -> b maybe Sem r ProjectNames forall (r :: EffectRow). Members '[Stop RainbowError, Embed IO] r => Sem r ProjectNames resolveName ProjectNames -> Sem r ProjectNames forall (f :: * -> *) a. Applicative f => a -> f a pure (ProjectOptions opts ProjectOptions -> Getting (Maybe ProjectNames) ProjectOptions (Maybe ProjectNames) -> Maybe ProjectNames forall s a. s -> Getting a s a -> a ^. IsLabel "names" (Getting (Maybe ProjectNames) ProjectOptions (Maybe ProjectNames)) Getting (Maybe ProjectNames) ProjectOptions (Maybe ProjectNames) #names) Path Abs Dir directory <- Sem r (Path Abs Dir) -> (Path Abs Dir -> Sem r (Path Abs Dir)) -> Maybe (Path Abs Dir) -> Sem r (Path Abs Dir) forall b a. b -> (a -> b) -> Maybe a -> b maybe (Bool -> Path Rel Dir -> Sem r (Path Abs Dir) forall (r :: EffectRow). Members '[Stop RainbowError, Embed IO] r => Bool -> Path Rel Dir -> Sem r (Path Abs Dir) cwdProjectPath Bool appendNameToCwd (ProjectNames names ProjectNames -> Getting (Path Rel Dir) ProjectNames (Path Rel Dir) -> Path Rel Dir forall s a. s -> Getting a s a -> a ^. IsLabel "nameDir" (Getting (Path Rel Dir) ProjectNames (Path Rel Dir)) Getting (Path Rel Dir) ProjectNames (Path Rel Dir) #nameDir)) Path Abs Dir -> Sem r (Path Abs Dir) forall (f :: * -> *) a. Applicative f => a -> f a pure (ProjectOptions opts ProjectOptions -> Getting (Maybe (Path Abs Dir)) ProjectOptions (Maybe (Path Abs Dir)) -> Maybe (Path Abs Dir) forall s a. s -> Getting a s a -> a ^. IsLabel "directory" (Getting (Maybe (Path Abs Dir)) ProjectOptions (Maybe (Path Abs Dir))) Getting (Maybe (Path Abs Dir)) ProjectOptions (Maybe (Path Abs Dir)) #directory) let name :: ProjectName name = ProjectNames names ProjectNames -> Getting ProjectName ProjectNames ProjectName -> ProjectName forall s a. s -> Getting a s a -> a ^. IsLabel "name" (Getting ProjectName ProjectNames ProjectName) Getting ProjectName ProjectNames ProjectName #name Maybe Github github <- Sem r (Maybe Github) -> (GithubOrg -> Sem r (Maybe Github)) -> Maybe GithubOrg -> Sem r (Maybe Github) forall b a. b -> (a -> b) -> Maybe a -> b maybe (ProjectName -> Maybe GithubRepo -> Sem r (Maybe Github) forall (r :: EffectRow). Members '[Stop RainbowError, Embed IO] r => ProjectName -> Maybe GithubRepo -> Sem r (Maybe Github) askGithub ProjectName name Maybe GithubRepo repo) ((Github -> Maybe Github) -> Sem r Github -> Sem r (Maybe Github) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b fmap Github -> Maybe Github forall a. a -> Maybe a Just (Sem r Github -> Sem r (Maybe Github)) -> (GithubOrg -> Sem r Github) -> GithubOrg -> Sem r (Maybe Github) forall b c a. (b -> c) -> (a -> b) -> a -> c . ProjectName -> Maybe GithubRepo -> GithubOrg -> Sem r Github forall (r :: EffectRow). Members '[Stop RainbowError, Embed IO] r => ProjectName -> Maybe GithubRepo -> GithubOrg -> Sem r Github withOrg ProjectName name Maybe GithubRepo repo) (ProjectOptions opts ProjectOptions -> Getting (Maybe GithubOrg) ProjectOptions (Maybe GithubOrg) -> Maybe GithubOrg forall s a. s -> Getting a s a -> a ^. IsLabel "githubOrg" (Getting (Maybe GithubOrg) ProjectOptions (Maybe GithubOrg)) Getting (Maybe GithubOrg) ProjectOptions (Maybe GithubOrg) #githubOrg) Maybe Cachix cachix <- Maybe CachixKey -> Maybe CachixName -> SkipCachix -> Sem r (Maybe Cachix) forall (r :: EffectRow). Members '[Stop RainbowError, Embed IO] r => Maybe CachixKey -> Maybe CachixName -> SkipCachix -> Sem r (Maybe Cachix) cachixOption (ProjectOptions opts ProjectOptions -> Getting (Maybe CachixKey) ProjectOptions (Maybe CachixKey) -> Maybe CachixKey forall s a. s -> Getting a s a -> a ^. IsLabel "cachixKey" (Getting (Maybe CachixKey) ProjectOptions (Maybe CachixKey)) Getting (Maybe CachixKey) ProjectOptions (Maybe CachixKey) #cachixKey) (ProjectOptions opts ProjectOptions -> Getting (Maybe CachixName) ProjectOptions (Maybe CachixName) -> Maybe CachixName forall s a. s -> Getting a s a -> a ^. IsLabel "cachixName" (Getting (Maybe CachixName) ProjectOptions (Maybe CachixName)) Getting (Maybe CachixName) ProjectOptions (Maybe CachixName) #cachixName) (ProjectOptions opts ProjectOptions -> Getting SkipCachix ProjectOptions SkipCachix -> SkipCachix forall s a. s -> Getting a s a -> a ^. IsLabel "skipCachix" (Getting SkipCachix ProjectOptions SkipCachix) Getting SkipCachix ProjectOptions SkipCachix #skipCachix) pure Project :: ProjectNames -> Maybe Github -> Maybe Cachix -> Path Abs Dir -> Branch -> Project Project {Maybe Cachix Maybe Github Path Abs Dir Branch ProjectNames $sel:branch:Project :: Branch $sel:directory:Project :: Path Abs Dir $sel:cachix:Project :: Maybe Cachix $sel:github:Project :: Maybe Github $sel:names:Project :: ProjectNames branch :: Branch cachix :: Maybe Cachix github :: Maybe Github directory :: Path Abs Dir names :: ProjectNames ..} where repo :: Maybe GithubRepo repo = ProjectOptions opts ProjectOptions -> Getting (Maybe GithubRepo) ProjectOptions (Maybe GithubRepo) -> Maybe GithubRepo forall s a. s -> Getting a s a -> a ^. IsLabel "githubRepo" (Getting (Maybe GithubRepo) ProjectOptions (Maybe GithubRepo)) Getting (Maybe GithubRepo) ProjectOptions (Maybe GithubRepo) #githubRepo branch :: Branch branch = Branch -> Maybe Branch -> Branch forall a. a -> Maybe a -> a fromMaybe Branch "master" (ProjectOptions opts ProjectOptions -> Getting (Maybe Branch) ProjectOptions (Maybe Branch) -> Maybe Branch forall s a. s -> Getting a s a -> a ^. IsLabel "branch" (Getting (Maybe Branch) ProjectOptions (Maybe Branch)) Getting (Maybe Branch) ProjectOptions (Maybe Branch) #branch)