module Ribosome.App.NewOptions where

import Path (Dir, Path, Rel, parseRelDir)
import Rainbow (chunk, fore, magenta)

import qualified Ribosome.App.Data as Data
import Ribosome.App.Data (FlakeUrl, NewProject (NewProject))
import Ribosome.App.Error (RainbowError, appError)
import Ribosome.App.Options (NewOptions)
import Ribosome.App.ProjectOptions (projectOptions)
import Ribosome.App.UserInput (askRequired)

defaultFlakeUrl :: FlakeUrl
defaultFlakeUrl :: FlakeUrl
defaultFlakeUrl =
  FlakeUrl
"git+https://git.tryp.io/tek/ribosome"

parseDir ::
  ToText a =>
  ToString a =>
  Member (Stop RainbowError) r =>
  a ->
  Sem r (Path Rel Dir)
parseDir :: forall a (r :: EffectRow).
(ToText a, ToString a, Member (Stop RainbowError) r) =>
a -> Sem r (Path Rel Dir)
parseDir a
name =
  RainbowError -> Maybe (Path Rel Dir) -> Sem r (Path Rel Dir)
forall err (r :: EffectRow) a.
Member (Stop err) r =>
err -> Maybe a -> Sem r a
stopNote RainbowError
invalidName (FilePath -> Maybe (Path Rel Dir)
forall (m :: * -> *). MonadThrow m => FilePath -> m (Path Rel Dir)
parseRelDir (a -> FilePath
forall a. ToString a => a -> FilePath
toString a
name))
  where
    invalidName :: RainbowError
invalidName =
      [Chunk] -> RainbowError
appError [Radiant -> Chunk -> Chunk
fore Radiant
magenta (Text -> Chunk
chunk (a -> Text
forall a. ToText a => a -> Text
toText a
name)), Item [Chunk]
" cannot be used as a directory name."]

newOptions ::
  Members [Stop RainbowError, Embed IO] r =>
  NewOptions ->
  Sem r NewProject
newOptions :: forall (r :: EffectRow).
Members '[Stop RainbowError, Embed IO] r =>
NewOptions -> Sem r NewProject
newOptions NewOptions
opts = do
  Project
project <- Bool -> ProjectOptions -> Sem r Project
forall (r :: EffectRow).
Members '[Stop RainbowError, Embed IO] r =>
Bool -> ProjectOptions -> Sem r Project
projectOptions Bool
True (NewOptions
opts NewOptions
-> Getting ProjectOptions NewOptions ProjectOptions
-> ProjectOptions
forall s a. s -> Getting a s a -> a
^. IsLabel
  "project" (Getting ProjectOptions NewOptions ProjectOptions)
Getting ProjectOptions NewOptions ProjectOptions
#project)
  Author
author <- Sem r Author
-> (Author -> Sem r Author) -> Maybe Author -> Sem r Author
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Text -> Sem r Author
forall a (r :: EffectRow).
(Eq a, IsString a, Members '[Stop RainbowError, Embed IO] r) =>
Text -> Sem r a
askRequired Text
"Author name for Cabal file?") Author -> Sem r Author
forall (f :: * -> *) a. Applicative f => a -> f a
pure (NewOptions
opts NewOptions
-> Getting (Maybe Author) NewOptions (Maybe Author) -> Maybe Author
forall s a. s -> Getting a s a -> a
^. IsLabel "author" (Getting (Maybe Author) NewOptions (Maybe Author))
Getting (Maybe Author) NewOptions (Maybe Author)
#author)
  Maintainer
maintainer <- Sem r Maintainer
-> (Maintainer -> Sem r Maintainer)
-> Maybe Maintainer
-> Sem r Maintainer
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Text -> Sem r Maintainer
forall a (r :: EffectRow).
(Eq a, IsString a, Members '[Stop RainbowError, Embed IO] r) =>
Text -> Sem r a
askRequired Text
"Maintainer email for Cabal file?") Maintainer -> Sem r Maintainer
forall (f :: * -> *) a. Applicative f => a -> f a
pure (NewOptions
opts NewOptions
-> Getting (Maybe Maintainer) NewOptions (Maybe Maintainer)
-> Maybe Maintainer
forall s a. s -> Getting a s a -> a
^. IsLabel
  "maintainer"
  (Getting (Maybe Maintainer) NewOptions (Maybe Maintainer))
Getting (Maybe Maintainer) NewOptions (Maybe Maintainer)
#maintainer)
  let
    flakeUrl :: FlakeUrl
flakeUrl =
      FlakeUrl -> Maybe FlakeUrl -> FlakeUrl
forall a. a -> Maybe a -> a
fromMaybe FlakeUrl
defaultFlakeUrl (NewOptions
opts NewOptions
-> Getting (Maybe FlakeUrl) NewOptions (Maybe FlakeUrl)
-> Maybe FlakeUrl
forall s a. s -> Getting a s a -> a
^. IsLabel
  "flakeUrl" (Getting (Maybe FlakeUrl) NewOptions (Maybe FlakeUrl))
Getting (Maybe FlakeUrl) NewOptions (Maybe FlakeUrl)
#flakeUrl)
    printDir :: PrintDir
printDir =
      NewOptions
opts NewOptions -> Getting PrintDir NewOptions PrintDir -> PrintDir
forall s a. s -> Getting a s a -> a
^. IsLabel "printDir" (Getting PrintDir NewOptions PrintDir)
Getting PrintDir NewOptions PrintDir
#printDir
  pure NewProject :: Project
-> FlakeUrl -> PrintDir -> Author -> Maintainer -> NewProject
NewProject {Project
PrintDir
Maintainer
Author
FlakeUrl
$sel:maintainer:NewProject :: Maintainer
$sel:author:NewProject :: Author
$sel:printDir:NewProject :: PrintDir
$sel:flakeUrl:NewProject :: FlakeUrl
$sel:project:NewProject :: Project
printDir :: PrintDir
flakeUrl :: FlakeUrl
maintainer :: Maintainer
author :: Author
project :: Project
..}