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)