ribosome-app (empty) → 0.9.9.9
raw patch · 30 files changed
+1959/−0 lines, 30 filesdep +basedep +chronosdep +exonsetup-changed
Dependencies added: base, chronos, exon, optparse-applicative, path, path-io, polysemy, polysemy-chronos, polysemy-plugin, polysemy-test, prelate, rainbow, ribosome-app, ribosome-host, tasty
Files
- LICENSE +34/−0
- Setup.hs +2/−0
- app/Main.hs +3/−0
- lib/Ribosome/App/Boot.hs +58/−0
- lib/Ribosome/App/Cli.hs +38/−0
- lib/Ribosome/App/Data.hs +132/−0
- lib/Ribosome/App/Data/TemplateTree.hs +9/−0
- lib/Ribosome/App/Error.hs +52/−0
- lib/Ribosome/App/NewOptions.hs +42/−0
- lib/Ribosome/App/NewProject.hs +40/−0
- lib/Ribosome/App/Options.hs +193/−0
- lib/Ribosome/App/ProjectNames.hs +22/−0
- lib/Ribosome/App/ProjectOptions.hs +98/−0
- lib/Ribosome/App/ProjectPath.hs +18/−0
- lib/Ribosome/App/TemplateTree.hs +59/−0
- lib/Ribosome/App/Templates.hs +93/−0
- lib/Ribosome/App/Templates/Boot.hs +126/−0
- lib/Ribosome/App/Templates/Flake.hs +65/−0
- lib/Ribosome/App/Templates/GithubActions.hs +73/−0
- lib/Ribosome/App/Templates/Hpack.hs +138/−0
- lib/Ribosome/App/Templates/License.hs +42/−0
- lib/Ribosome/App/Templates/MainHs.hs +12/−0
- lib/Ribosome/App/Templates/PingTestHs.hs +25/−0
- lib/Ribosome/App/Templates/PluginHs.hs +54/−0
- lib/Ribosome/App/Templates/ReadmeMd.hs +50/−0
- lib/Ribosome/App/Templates/TestMainHs.hs +25/−0
- lib/Ribosome/App/UserInput.hs +94/−0
- ribosome-app.cabal +297/−0
- test/Main.hs +15/−0
- test/Ribosome/App/Test/NewProjectTest.hs +50/−0
+ LICENSE view
@@ -0,0 +1,34 @@+Copyright (c) 2022 Torsten Schmits++Redistribution and use in source and binary forms, with or without modification, are permitted provided that the+following conditions are met:++ 1. Redistributions of source code must retain the above copyright notice, this list of conditions and the following+ disclaimer.+ 2. Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following+ disclaimer in the documentation and/or other materials provided with the distribution.++Subject to the terms and conditions of this license, each copyright holder and contributor hereby grants to those+receiving rights under this license a perpetual, worldwide, non-exclusive, no-charge, royalty-free, irrevocable (except+for failure to satisfy the conditions of this license) patent license to make, have made, use, offer to sell, sell,+import, and otherwise transfer this software, where such license applies only to those patent claims, already acquired+or hereafter acquired, licensable by such copyright holder or contributor that are necessarily infringed by:++ (a) their Contribution(s) (the licensed copyrights of copyright holders and non-copyrightable additions of+ contributors, in source or binary form) alone; or+ (b) combination of their Contribution(s) with the work of authorship to which such Contribution(s) was added by such+ copyright holder or contributor, if, at the time the Contribution is added, such addition causes such combination to+ be necessarily infringed. The patent license shall not apply to any other combinations which include the Contribution.++Except as expressly stated above, no rights or licenses from any copyright holder or contributor is granted under this+license, whether expressly, by implication, estoppel or otherwise.++DISCLAIMER++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES,+INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE+DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDERS OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR+SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,+WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF+THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ app/Main.hs view
@@ -0,0 +1,3 @@+module Main (module Ribosome.App.Cli) where++import Ribosome.App.Cli (main)
+ lib/Ribosome/App/Boot.hs view
@@ -0,0 +1,58 @@+module Ribosome.App.Boot where++import Exon (exon)+import Rainbow (Chunk)++import Ribosome.App.Data (Github (Github), GithubOrg (GithubOrg), GithubRepo (GithubRepo), Global, Project (..))+import Ribosome.App.Error (RainbowError)+import Ribosome.App.TemplateTree (writeTemplateTree)+import Ribosome.App.Templates (bootTemplates)+import Ribosome.App.UserInput (infoMessage, linkChunk, neovimChunk, pathColor, putStderr)++githubMessage :: [Chunk]+githubMessage =+ [+ "Github Actions files are in ",+ pathColor ".github/workflows",+ ". These will release static binaries for each commit and tag."+ ]++githubBootMessage :: Github -> [Chunk]+githubBootMessage (Github (GithubOrg org) (GithubRepo repo)) =+ [+ "When ",+ neovimChunk,+ " starts, a binary will be fetched from ",+ linkChunk [exon|github.com/#{org}/#{repo}|],+ " if Nix isn't available."+ ]++secretsUrl :: Github -> Chunk+secretsUrl (Github (GithubOrg org) (GithubRepo repo)) =+ linkChunk [exon|https://github.com/#{org}/#{repo}/settings/secrets/actions|]++generateBoot ::+ Members [Stop RainbowError, Embed IO] r =>+ Global ->+ Project ->+ Sem r ()+generateBoot global Project {..} = do+ writeTemplateTree global directory (bootTemplates (names ^. #name) branch github cachix)+ unless (global ^. #quiet) do+ infoMessage [+ "The ",+ neovimChunk,+ " boot file is at ",+ pathColor "plugin/boot.vim",+ "."+ ]+ infoMessage ["Place the project directory in one of your ", pathColor "packpath", " directories to start it."]+ putStderr ""+ for_ github \ gh -> do+ infoMessage githubMessage+ infoMessage (githubBootMessage gh)+ when (isJust cachix) do+ putStderr ""+ infoMessage ["You have to add your Cachix signing key here: ", secretsUrl gh, "."]+ infoMessage ["The secret name should be ", pathColor "CACHIX_SIGNING_KEY", "."]+ infoMessage ["A key can be created with ", pathColor "cachix generate-keypair", "."]
+ lib/Ribosome/App/Cli.hs view
@@ -0,0 +1,38 @@+module Ribosome.App.Cli where++import Polysemy.Chronos (ChronosTime, interpretTimeChronos)+import System.Exit (exitFailure)+import System.IO (stderr)++import Ribosome.App.Boot (generateBoot)+import Ribosome.App.Data (Global (Global))+import Ribosome.App.Error (RainbowError, runRainbowErrorAnd)+import Ribosome.App.NewOptions (newOptions)+import Ribosome.App.NewProject (newProject)+import Ribosome.App.Options (Command (Boot, New), GlobalOptions (GlobalOptions), Options (..), parseCli)+import Ribosome.App.ProjectOptions (projectOptions)++runCommand ::+ Members [ChronosTime, Stop RainbowError, Embed IO] r =>+ Global ->+ Command ->+ Sem r ()+runCommand global = \case+ New opts -> do+ conf <- newOptions opts+ newProject global conf+ Boot opts -> do+ conf <- projectOptions False opts+ generateBoot global conf++runOptions ::+ Members [ChronosTime, Stop RainbowError, Embed IO] r =>+ Options ->+ Sem r ()+runOptions (Options (GlobalOptions quiet force) cmd) =+ runCommand (Global (fromMaybe False quiet) (fromMaybe False force)) cmd++main :: IO ()+main = do+ conf <- parseCli+ runConc $ interpretTimeChronos (runRainbowErrorAnd stderr (embed exitFailure) (runOptions conf))
+ lib/Ribosome/App/Data.hs view
@@ -0,0 +1,132 @@+module Ribosome.App.Data where++import Path (Abs, Dir, Path, Rel)++newtype ProjectName =+ ProjectName { unProjectName :: Text }+ deriving stock (Eq, Show)+ deriving newtype (IsString, Ord)++newtype ModuleName =+ ModuleName { unModuleName :: Text }+ deriving stock (Eq, Show)+ deriving newtype (IsString, Ord)++data ProjectNames =+ ProjectNames {+ name :: ProjectName,+ nameDir :: Path Rel Dir,+ moduleName :: ModuleName,+ moduleNameDir :: Path Rel Dir+ }+ deriving stock (Eq, Show, Generic)++newtype GithubOrg =+ GithubOrg { unGithubOrg :: Text }+ deriving stock (Eq, Show)+ deriving newtype (IsString, Ord)++newtype GithubRepo =+ GithubRepo { unGithubRepo :: Text }+ deriving stock (Eq, Show)+ deriving newtype (IsString, Ord)++newtype CachixName =+ CachixName { unCachixName :: Text }+ deriving stock (Eq, Show)+ deriving newtype (IsString, Ord)++newtype CachixKey =+ CachixKey { unCachixKey :: Text }+ deriving stock (Eq, Show)+ deriving newtype (IsString, Ord)++newtype SkipCachix =+ SkipCachix { unSkipCachix :: Bool }+ deriving stock (Eq, Show)++instance Default SkipCachix where+ def =+ SkipCachix False++newtype FlakeUrl =+ FlakeUrl { unFlakeUrl :: Text }+ deriving stock (Eq, Show)+ deriving newtype (IsString, Ord)++newtype Branch =+ Branch { unBranch :: Text }+ deriving stock (Eq, Show)+ deriving newtype (IsString, Ord)++newtype Author =+ Author { unAuthor :: Text }+ deriving stock (Eq, Show)+ deriving newtype (IsString, Ord)++newtype Maintainer =+ Maintainer { unMaintainer :: Text }+ deriving stock (Eq, Show)+ deriving newtype (IsString, Ord)++newtype Year =+ Year { unYear :: Int }+ deriving stock (Eq, Show)+ deriving newtype (Num, Real, Enum, Integral, Ord)++newtype PrintDir =+ PrintDir { unPrintDir :: Bool }+ deriving stock (Eq, Show)++instance Default PrintDir where+ def =+ PrintDir False++data Github =+ Github {+ org :: GithubOrg,+ repo :: GithubRepo+ }+ deriving stock (Eq, Show, Generic)++data Cachix =+ Cachix {+ cachixName :: CachixName,+ cachixKey :: CachixKey+ }+ deriving stock (Eq, Show, Generic)++cachixTek :: Cachix+cachixTek =+ Cachix "tek" "tek.cachix.org-1:+sdc73WFq8aEKnrVv5j/kuhmnW2hQJuqdPJF5SnaCBk="++data Project =+ Project {+ names :: ProjectNames,+ github :: Maybe Github,+ cachix :: Maybe Cachix,+ directory :: Path Abs Dir,+ branch :: Branch+ }+ deriving stock (Eq, Show, Generic)++data Global =+ Global {+ quiet :: Bool,+ force :: Bool+ }+ deriving stock (Eq, Show, Generic)++instance Default Global where+ def =+ Global False False++data NewProject =+ NewProject {+ project :: Project,+ flakeUrl :: FlakeUrl,+ printDir :: PrintDir,+ author :: Author,+ maintainer :: Maintainer+ }+ deriving stock (Eq, Show, Generic)
+ lib/Ribosome/App/Data/TemplateTree.hs view
@@ -0,0 +1,9 @@+module Ribosome.App.Data.TemplateTree where++import Path (Dir, File, Path, Rel)++data TemplateTree =+ TDir (Path Rel Dir) [TemplateTree]+ |+ TFile (Path Rel File) Text+ deriving stock (Eq, Show)
+ lib/Ribosome/App/Error.hs view
@@ -0,0 +1,52 @@+module Ribosome.App.Error where++import Rainbow (Chunk, chunk, faint, fore, hPutChunksLn, red)+import System.IO (Handle)+++newtype RainbowError =+ RainbowError { unRainbowError :: NonEmpty (NonEmpty Chunk) }+ deriving newtype (Semigroup)++instance IsString RainbowError where+ fromString =+ RainbowError . pure . pure . fromString++appError :: [Chunk] -> RainbowError+appError msg =+ RainbowError ["⚠️ " :| (fore red "Error ") : msg]++ioError :: [Chunk] -> Text -> RainbowError+ioError msg err =+ appError msg <> RainbowError [["🗨️ ", fore red (faint (chunk err))]]++outputError ::+ Members [Stop RainbowError, Embed IO] r =>+ IO a ->+ Sem r a+outputError =+ stopTryIOError err+ where+ err =+ ioError ["Printing message failed"]++runRainbowErrorAnd ::+ Members [Embed IO, Final IO] r =>+ Handle ->+ Sem r () ->+ Sem (Stop RainbowError : r) () ->+ Sem r ()+runRainbowErrorAnd handle after action = do+ either onError pure =<< stopToIOFinal action+ where+ onError (RainbowError cs) = do+ tryIOError_ (traverse_ (hPutChunksLn handle . toList) cs)+ after++runRainbowError ::+ Members [Embed IO, Final IO] r =>+ Handle ->+ Sem (Stop RainbowError : r) () ->+ Sem r ()+runRainbowError handle =+ runRainbowErrorAnd handle unit
+ lib/Ribosome/App/NewOptions.hs view
@@ -0,0 +1,42 @@+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 =+ "git+https://git.tryp.io/tek/ribosome"++parseDir ::+ ToText a =>+ ToString a =>+ Member (Stop RainbowError) r =>+ a ->+ Sem r (Path Rel Dir)+parseDir name =+ stopNote invalidName (parseRelDir (toString name))+ where+ invalidName =+ appError [fore magenta (chunk (toText name)), " cannot be used as a directory name."]++newOptions ::+ Members [Stop RainbowError, Embed IO] r =>+ NewOptions ->+ Sem r NewProject+newOptions opts = do+ project <- projectOptions True (opts ^. #project)+ author <- maybe (askRequired "Author name for Cabal file?") pure (opts ^. #author)+ maintainer <- maybe (askRequired "Maintainer email for Cabal file?") pure (opts ^. #maintainer)+ let+ flakeUrl =+ fromMaybe defaultFlakeUrl (opts ^. #flakeUrl)+ printDir =+ opts ^. #printDir+ pure NewProject {..}
+ lib/Ribosome/App/NewProject.hs view
@@ -0,0 +1,40 @@+module Ribosome.App.NewProject where++import qualified Data.Text.IO as Text+import Polysemy.Chronos (ChronosTime)+import qualified Time++import Ribosome.App.Boot (generateBoot)+import Ribosome.App.Data (Global (..), NewProject (..), Project (..), unPrintDir)+import Ribosome.App.Error (RainbowError)+import Ribosome.App.TemplateTree (writeTemplateTree)+import Ribosome.App.Templates (newProjectTemplates)+import Ribosome.App.UserInput (cmdColor, infoMessage, neovimChunk, pathChunk, pathColor, putStderr)+import Ribosome.Host.Path (pathText)++newProject ::+ Members [ChronosTime, Stop RainbowError, Embed IO] r =>+ Global ->+ NewProject ->+ Sem r ()+newProject global NewProject {project = pro@Project {..}, ..} = do+ year <- fromIntegral . Time.year <$> Time.today+ writeTemplateTree global directory (newProjectTemplates names flakeUrl author maintainer branch github cachix year)+ unless (global ^. #quiet) do+ infoMessage [+ "🌝 Initialized a ",+ neovimChunk,+ " plugin project in ",+ pathChunk directory,+ "."+ ]+ infoMessage [+ "Run ",+ cmdColor "nix build .#static",+ " in that directory to create a statically linked executable in ",+ pathColor "result/bin",+ "."+ ]+ putStderr ""+ generateBoot global pro+ when (unPrintDir printDir) (embed (Text.putStrLn (pathText directory)))
+ lib/Ribosome/App/Options.hs view
@@ -0,0 +1,193 @@+module Ribosome.App.Options where++import Options.Applicative (+ CommandFields,+ Mod,+ Parser,+ ReadM,+ argument,+ command,+ customExecParser,+ fullDesc,+ header,+ help,+ helper,+ hsubparser,+ info,+ long,+ metavar,+ option,+ prefs,+ progDesc,+ readerError,+ short,+ showHelpOnEmpty,+ showHelpOnError,+ str,+ switch,+ )+import Options.Applicative.Types (readerAsk)+import Path (Abs, Dir, Path)+import Path.IO (getCurrentDir)+import Prelude hiding (Mod)++import Ribosome.App.Data (+ Author,+ Branch,+ CachixKey,+ CachixName,+ FlakeUrl,+ GithubOrg,+ GithubRepo,+ Maintainer,+ PrintDir (PrintDir),+ ProjectNames (..),+ SkipCachix (SkipCachix),+ )+import qualified Ribosome.App.ProjectNames as ProjectNames+import Ribosome.Host.Optparse (dirPathOption)++data ProjectOptions =+ ProjectOptions {+ names :: Maybe ProjectNames,+ directory :: Maybe (Path Abs Dir),+ branch :: Maybe Branch,+ githubOrg :: Maybe GithubOrg,+ githubRepo :: Maybe GithubRepo,+ skipCachix :: SkipCachix,+ cachixName :: Maybe CachixName,+ cachixKey :: Maybe CachixKey+ }+ deriving stock (Eq, Show, Generic)+ deriving anyclass (Default)++data NewOptions =+ NewOptions {+ project :: ProjectOptions,+ flakeUrl :: Maybe FlakeUrl,+ printDir :: PrintDir,+ author :: Maybe Author,+ maintainer :: Maybe Maintainer+ }+ deriving stock (Eq, Show, Generic)+ deriving anyclass (Default)++data Command =+ New NewOptions+ |+ Boot ProjectOptions+ deriving stock (Eq, Show)++data GlobalOptions =+ GlobalOptions {+ quiet :: Maybe Bool,+ force :: Maybe Bool+ }+ deriving stock (Eq, Show, Generic)+ deriving anyclass (Default)++data Options =+ Options {+ global :: GlobalOptions,+ cmd :: Command+ }+ deriving stock (Eq, Show)++projectNamesOption ::+ ReadM ProjectNames+projectNamesOption = do+ raw <- readerAsk+ either readerError pure (ProjectNames.parse raw)++directoryParser ::+ Path Abs Dir ->+ Parser (Maybe (Path Abs Dir))+directoryParser cwd =+ optional (option (dirPathOption cwd) (long "directory" <> short 'd' <> help dirHelp))+ where+ dirHelp =+ "The directory for the new project. Defaults to the project name as subdir of the current dir"++projectParser ::+ Path Abs Dir ->+ Parser ProjectOptions+projectParser cwd =+ ProjectOptions+ <$>+ optional (argument projectNamesOption (metavar "NAME" <> help "Name of the project"))+ <*>+ directoryParser cwd+ <*>+ optional (option str (long "branch" <> short 'b' <> help branchHelp))+ <*>+ optional (option str (long "github-org" <> short 'o' <> help orgHelp))+ <*>+ optional (option str (long "github-repo" <> short 'r' <> help repoHelp))+ <*>+ (SkipCachix <$> switch (long "skip-cachix" <> help "Don't ask for cachix credentials"))+ <*>+ optional (option str (long "cachix" <> short 'c' <> help cachixHelp))+ <*>+ optional (option str (long "cachix-key" <> short 'k' <> help cachixKeyHelp))+ where+ orgHelp =+ "Name of the Github org, for generating vim boot files that download binaries built by Actions"+ repoHelp =+ "Name of the Github repo, in case it differs from the project name"+ branchHelp =+ "Main branch for creating binaries via Github Actions, defaults to 'master'"+ cachixHelp =+ "Name of the cachix cache to push to from Github Actions, and pull from in the Neovim boot file"+ cachixKeyHelp =+ "The public key for the cachix cache, found at https://app.cachix.org/cache/<name>"++newParser ::+ Path Abs Dir ->+ Parser NewOptions+newParser cwd =+ NewOptions+ <$>+ projectParser cwd+ <*>+ optional (option str (long "flake-url" <> short 'f' <> help "Custom URL for the Ribosome flake"))+ <*>+ (PrintDir <$> switch (long "print-dir" <> short 'p' <> help "Write the generated directory to stdout"))+ <*>+ optional (option str (long "author" <> short 'a' <> help "Author for the Cabal file"))+ <*>+ optional (option str (long "maintainer" <> short 'm' <> help "Maintainer for the Cabal file"))++newCommand ::+ Path Abs Dir ->+ Mod CommandFields Command+newCommand cwd =+ command "new" (New <$> info (newParser cwd) (progDesc "Generate a new project for a Neovim plugin"))++bootCommand ::+ Path Abs Dir ->+ Mod CommandFields Command+bootCommand cwd =+ command "boot" (Boot <$> info (projectParser cwd) (progDesc "Generate the Neovim boot file"))++globalParser :: Parser GlobalOptions+globalParser = do+ quiet <- optional (switch (long "quiet" <> short 'q' <> help "Suppress informational messages"))+ force <- optional (switch (long "force" <> short 'f' <> help "Overwrite existing files"))+ pure (GlobalOptions {..})++appParser ::+ Path Abs Dir ->+ Parser Options+appParser cwd =+ Options <$> globalParser <*> hsubparser (mconcat [newCommand cwd, bootCommand cwd])++parseCli ::+ IO Options+parseCli = do+ cwd <- getCurrentDir+ customExecParser parserPrefs (info (appParser cwd <**> helper) desc)+ where+ parserPrefs =+ prefs (showHelpOnEmpty <> showHelpOnError)+ desc =+ fullDesc <> header "Tools for maintaining Ribosome plugins"
+ lib/Ribosome/App/ProjectNames.hs view
@@ -0,0 +1,22 @@+module Ribosome.App.ProjectNames where++import Path (parseRelDir)++import Ribosome.App.Data (ModuleName (ModuleName), ProjectName (ProjectName), ProjectNames (..))+import Ribosome.Host.Text (pascalCase)++parse ::+ IsString err =>+ String ->+ Either err ProjectNames+parse raw = do+ let+ name = ProjectName (toText raw)+ modRaw = pascalCase raw+ moduleName = ModuleName (toText modRaw)+ nameDir <- maybe err pure (parseRelDir raw)+ moduleNameDir <- maybe err pure (parseRelDir modRaw)+ pure ProjectNames {..}+ where+ err =+ Left "The project name must be usable as a directory name"
+ lib/Ribosome/App/ProjectOptions.hs view
@@ -0,0 +1,98 @@+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 = do+ name <- askRequired "Name of the project?"+ stopEitherWith err (ProjectNames.parse name)+ where+ err =+ appError . pure++askGithubRepo ::+ Members [Stop RainbowError, Embed IO] r =>+ ProjectName ->+ Sem r GithubRepo+askGithubRepo (ProjectName name) =+ fromMaybe (GithubRepo name) <$> askUser "Github repository name? (Empty uses project name)"++withOrg ::+ Members [Stop RainbowError, Embed IO] r =>+ ProjectName ->+ Maybe GithubRepo ->+ GithubOrg ->+ Sem r Github+withOrg name repo org =+ Github org <$> maybe (askGithubRepo name) pure repo++askGithub ::+ Members [Stop RainbowError, Embed IO] r =>+ ProjectName ->+ Maybe GithubRepo ->+ Sem r (Maybe Github)+askGithub name repo =+ traverse (withOrg name repo) =<< askUser "Github organization? (Empty skips Github)"++withCachixName ::+ Members [Stop RainbowError, Embed IO] r =>+ Maybe CachixKey ->+ CachixName ->+ Sem r Cachix+withCachixName key name =+ Cachix name <$> maybe (askRequired "Cachix public key?") pure key++askCachix ::+ Members [Stop RainbowError, Embed IO] r =>+ Maybe CachixKey ->+ Sem r (Maybe Cachix)+askCachix key =+ traverse (withCachixName key) =<< askUser "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 cachixKey cachixName = \case+ SkipCachix True ->+ pure Nothing+ SkipCachix False ->+ maybe (askCachix cachixKey) (fmap Just . withCachixName cachixKey) cachixName++projectOptions ::+ Members [Stop RainbowError, Embed IO] r =>+ Bool ->+ ProjectOptions ->+ Sem r Project+projectOptions appendNameToCwd opts = do+ names <- maybe resolveName pure (opts ^. #names)+ directory <- maybe (cwdProjectPath appendNameToCwd (names ^. #nameDir)) pure (opts ^. #directory)+ let name = names ^. #name+ github <- maybe (askGithub name repo) (fmap Just . withOrg name repo) (opts ^. #githubOrg)+ cachix <- cachixOption (opts ^. #cachixKey) (opts ^. #cachixName) (opts ^. #skipCachix)+ pure Project {..}+ where+ repo =+ opts ^. #githubRepo+ branch =+ fromMaybe "master" (opts ^. #branch)
+ lib/Ribosome/App/ProjectPath.hs view
@@ -0,0 +1,18 @@+module Ribosome.App.ProjectPath where++import Path (Abs, Dir, Path, Rel, (</>))+import Path.IO (getCurrentDir)++import Ribosome.App.Error (RainbowError, ioError)++cwdProjectPath ::+ Members [Stop RainbowError, Embed IO] r =>+ Bool ->+ Path Rel Dir ->+ Sem r (Path Abs Dir)+cwdProjectPath append name = do+ cwd <- stopTryIOError err getCurrentDir+ pure (if append then cwd </> name else cwd)+ where+ err =+ ioError ["Could not determine current directory"]
+ lib/Ribosome/App/TemplateTree.hs view
@@ -0,0 +1,59 @@+module Ribosome.App.TemplateTree where++import qualified Data.Text.IO as Text+import Path (Abs, Dir, File, Path, Rel, parent, reldir, toFilePath, (</>))+import Path.IO (createDirIfMissing, doesFileExist)++import Ribosome.App.Data (Global (..))+import Ribosome.App.Data.TemplateTree (TemplateTree (TDir, TFile))+import Ribosome.App.Error (RainbowError, ioError)+import Ribosome.App.UserInput (cmdColor, infoMessage, pathChunk)++warnExists ::+ Members [Stop RainbowError, Embed IO] r =>+ Path Rel File ->+ Sem r ()+warnExists file =+ infoMessage [+ "⚠️ Not overwriting ",+ pathChunk file,+ " without ",+ cmdColor "--force"+ ]++writeTemplate ::+ Members [Stop RainbowError, Embed IO] r =>+ Global ->+ Path Abs File ->+ Path Rel File ->+ Text ->+ Sem r ()+writeTemplate Global {..} path relPath content = do+ stopTryIOError dirError (createDirIfMissing True dir)+ exists <- embed (doesFileExist path)+ if exists && not force+ then unless quiet (warnExists relPath)+ else stopTryIOError writeError (Text.writeFile (toFilePath path) content)+ where+ writeError msg =+ ioError ["Failed to write ", pathChunk path] msg+ dirError =+ ioError ["Failed to create directory ", pathChunk dir]+ dir =+ parent path++writeTemplateTree ::+ Members [Stop RainbowError, Embed IO] r =>+ Global ->+ Path Abs Dir ->+ TemplateTree ->+ Sem r ()+writeTemplateTree global root =+ spin [reldir|.|]+ where+ spin current = \case+ TDir sub nodes ->+ traverse_ (spin (current </> sub)) nodes+ TFile name content ->+ let file = current </> name+ in writeTemplate global (root </> file) file content
+ lib/Ribosome/App/Templates.hs view
@@ -0,0 +1,93 @@+module Ribosome.App.Templates where++import Exon (exon)+import Path (reldir, relfile)++import Ribosome.App.Data (+ Author,+ Branch,+ Cachix,+ FlakeUrl,+ Github,+ Maintainer,+ ProjectName,+ ProjectNames (..),+ Year,+ )+import Ribosome.App.Data.TemplateTree (TemplateTree (TDir, TFile))+import Ribosome.App.Templates.Boot (vimBoot)+import Ribosome.App.Templates.Flake (flakeNix)+import Ribosome.App.Templates.GithubActions (gaLatest, gaTags)+import Ribosome.App.Templates.Hpack (hpackNix)+import Ribosome.App.Templates.License (license)+import Ribosome.App.Templates.MainHs (mainHs)+import Ribosome.App.Templates.PingTestHs (pingTestHs)+import Ribosome.App.Templates.PluginHs (pluginHs)+import Ribosome.App.Templates.ReadmeMd (readmeMd)+import Ribosome.App.Templates.TestMainHs (testMainHs)++pluginDir ::+ ProjectName ->+ Maybe Github ->+ Maybe Cachix ->+ TemplateTree+pluginDir name github cachix =+ TDir [reldir|plugin|] [+ TFile [relfile|boot.vim|] (vimBoot name github cachix)+ ]++newProjectTemplates ::+ ProjectNames ->+ FlakeUrl ->+ Author ->+ Maintainer ->+ Branch ->+ Maybe Github ->+ Maybe Cachix ->+ Year ->+ TemplateTree+newProjectTemplates ProjectNames {..} flakeUrl author maintainer branch github cachix year =+ TDir [reldir|.|] [+ TFile [relfile|flake.nix|] (flakeNix flakeUrl name branch github cachix),+ TFile [relfile|readme.md|] (readmeMd name github),+ TDir [reldir|packages|] [+ TDir nameDir [+ TFile [relfile|LICENSE|] (license author),+ TFile [relfile|readme.md|] (readmeMd name github),+ TFile [relfile|changelog.md|] "# Unreleased",+ TFile [relfile|app/Main.hs|] (mainHs moduleName),+ TDir [reldir|lib|] [+ TDir moduleNameDir [+ TFile [relfile|Plugin.hs|] (pluginHs name moduleName)+ ]+ ],+ TDir [reldir|test|] [+ TFile [relfile|Main.hs|] (testMainHs moduleName),+ TDir moduleNameDir [+ TDir [reldir|Test|] [+ TFile [relfile|PingTest.hs|] (pingTestHs moduleName)+ ]+ ]+ ]+ ]+ ],+ TDir [reldir|ops|] [+ TFile [relfile|hpack.nix|] (hpackNix name author maintainer year github),+ TFile [relfile|version.nix|] [exon|"0.1.0.0"|]+ ]+ ]++bootTemplates ::+ ProjectName ->+ Branch ->+ Maybe Github ->+ Maybe Cachix ->+ TemplateTree+bootTemplates name branch github cachix =+ TDir [reldir|.|] [+ pluginDir name github cachix,+ TDir [reldir|.github/workflows|] [+ TFile [relfile|latest.yml|] (gaLatest name branch cachix),+ TFile [relfile|tags.yml|] (gaTags name cachix)+ ]+ ]
+ lib/Ribosome/App/Templates/Boot.hs view
@@ -0,0 +1,126 @@+module Ribosome.App.Templates.Boot where++import Exon (exon)++import Ribosome.App.Data (+ Cachix (Cachix),+ CachixKey (CachixKey),+ CachixName (CachixName),+ Github (Github),+ GithubOrg (GithubOrg),+ GithubRepo (GithubRepo),+ ProjectName (ProjectName),+ cachixTek,+ )++cachixOpts :: Cachix -> Text+cachixOpts (Cachix (CachixName name) (CachixKey key)) =+ [exon|+ \ '--option', 'extra-substituters', 'https://#{name}.cachix.org',+ \ '--option', 'extra-trusted-public-keys', '#{key}',|]++github :: ProjectName -> Github -> Text+github (ProjectName name) (Github (GithubOrg org) (GithubRepo repo)) =+ [exon|let s:gh_exe = s:repo . '/github-exe'+let s:fetch_cmd = [+ \ 'curl',+ \ '--no-progress-meter',+ \ '--location',+ \ '--create-dirs',+ \ '--output',+ \ s:gh_exe,+ \ 'https://github.com/#{org}/#{repo}/releases/download/latest/#{name}'+ \ ]+|]++build :: ProjectName -> Bool -> Text+build (ProjectName name) = \case+ True ->+ [exon|if filereadable(s:exe)+ call s:run(s:exe)+elseif filereadable(s:gh_exe)+ call s:run(s:gh_exe)+else+ if executable('nix') && !get(g:, '#{name}_fetch_bin', 0)+ echo 'Building #{name}...'+ call s:nix_build()+ else+ echo 'Fetching the #{name} executable from github...'+ call s:fetch_bin()+ endif+endif+|]+ False ->+ [exon|if filereadable(s:exe)+ call s:run(s:exe)+else+ if executable('nix')+ echo 'Building #{name}...'+ call s:nix_build()+ else+ echo 'Cannot build #{name} without Nix'+ endif+endif+|]++vimBoot :: ProjectName -> Maybe Github -> Maybe Cachix -> Text+vimBoot pn@(ProjectName name) gh cachix =+ [exon|let s:repo = fnamemodify(expand('<sfile>'), ':p:h:h')+let s:exe = s:repo . '/result/bin/#{name}'+let s:build_cmd = [+ \ 'nix',#{cachixOpts (fromMaybe cachixTek cachix)}+ \ 'build', '.##{name}',+ \ ]+let s:errors = []++function! s:run(exe) abort "{{{+ call jobstart([a:exe] + get(g:, '#{name}_cli_args', []), { 'rpc': v:true, 'cwd': s:repo, })+endfunction "}}}++function! s:error(msg) abort "{{{+ call nvim_echo(+ \ [[a:msg . ":\n", 'Error']] ++ \ map(s:errors, { i, s -> [s, 'Error'] }),+ \ v:false, {})+endfunction "}}}++function! s:built(code) abort "{{{+ if a:code == 0+ call s:run(s:exe)+ else+ call s:error('Failed to build #{name}')+ endif+endfunction "}}}++function! s:nix_build() abort "{{{+ call jobstart(s:build_cmd, {+ \ 'cwd': s:repo,+ \ 'on_exit': { i, code, n -> s:built(code) },+ \ 'on_stderr': { i, data, n -> s:stderr(data) },+ \ })+endfunction "}}}++function! s:fetched(code) abort "{{{+ if a:code == 0+ call system(['chmod', '+x', s:gh_exe])+ call s:run(s:gh_exe)+ else+ call s:error('Failed to fetch the #{name} executable from github')+ endif+endfunction "}}}++function! s:stderr(data) abort "{{{+ call extend(s:errors, a:data)+endfunction "}}}++function! s:fetch_bin() abort "{{{+ call jobstart(s:fetch_cmd, {+ \ 'cwd': s:repo,+ \ 'on_exit': { i, code, n -> s:fetched(code) },+ \ 'on_stderr': { i, data, n -> s:stderr(data) },+ \ })+endfunction "}}}++#{maybe "" (github pn) gh}+#{build pn (isJust gh)}+|]
+ lib/Ribosome/App/Templates/Flake.hs view
@@ -0,0 +1,65 @@+module Ribosome.App.Templates.Flake where++import Exon (exon)++import Ribosome.App.Data (+ Branch (Branch),+ Cachix (Cachix),+ CachixKey (CachixKey),+ CachixName (CachixName),+ FlakeUrl (FlakeUrl),+ Github (Github),+ GithubOrg (GithubOrg),+ GithubRepo (GithubRepo),+ ProjectName (ProjectName),+ )++githubAttrs :: Github -> Text+githubAttrs (Github (GithubOrg org) (GithubRepo repo)) =+ [exon|+ githubOrg = "#{org}";+ githubRepo = "#{repo}";|]++cachixAttrs :: Cachix -> Text+cachixAttrs (Cachix (CachixName name) (CachixKey key)) =+ [exon|+ cachixName = "#{name}";+ cachixKey = "#{key}";|]++flakeNix ::+ FlakeUrl ->+ ProjectName ->+ Branch ->+ Maybe Github ->+ Maybe Cachix ->+ Text+flakeNix (FlakeUrl flakeUrl) (ProjectName name) (Branch branch) github cachix =+ [exon|{+ description = "A Neovim Plugin";++ inputs = {+ ribosome.url = "#{flakeUrl}";+ };++ outputs = { ribosome, ... }: ribosome.lib.flake ({ config, lib, ... }: {+ base = ./.;+ packages.#{name} = ./packages/#{name};+ main = "#{name}";+ exe = "#{name}";+ branch = "#{branch}";#{foldMap githubAttrs github}#{foldMap cachixAttrs cachix}+ depsFull = [ribosome];+ devGhc.compiler = "ghc902";+ overrides = { buildInputs, pkgs, ... }: {+ #{name} = buildInputs [pkgs.neovim pkgs.tmux pkgs.xterm];+ };+ hpack.packages = import ./ops/hpack.nix { inherit config lib; };+ hackage.versionFile = "ops/version.nix";+ ghcid.shellConfig.buildInputs = with config.pkgs; [pkgs.neovim pkgs.tmux];+ ghci = {+ preludePackage = "prelate";+ preludeModule = "Prelate";+ args = ["-fplugin=Polysemy.Plugin"];+ };+ });+}+|]
+ lib/Ribosome/App/Templates/GithubActions.hs view
@@ -0,0 +1,73 @@+module Ribosome.App.Templates.GithubActions where++import Exon (exon)++import Ribosome.App.Data (Branch (Branch), Cachix (Cachix), CachixKey (CachixKey), CachixName (CachixName), ProjectName (ProjectName), cachixName, cachixTek)++cachixStep :: CachixName -> Text+cachixStep (CachixName name) =+ [exon|+ - uses: cachix/cachix-action@v10+ with:+ name: #{name}+ signingKey: '${{ secrets.CACHIX_SIGNING_KEY }}'|]++cachixConf :: Cachix -> Text+cachixConf (Cachix (CachixName name) (CachixKey key)) =+ [exon|+ extra-substituters = https://#{name}.cachix.org+ extra-trusted-public-keys = #{key}|]++ga ::+ ProjectName ->+ Maybe Cachix ->+ Text ->+ Text ->+ Text ->+ Text+ga (ProjectName name) cachix actionName push release =+ [exon|---+name: '#{actionName}'++on:+ push:+ #{push}++jobs:+ release:+ name: 'Release'+ runs-on: ubuntu-latest+ steps:+ - uses: actions/checkout@v2.4.0+ - uses: cachix/install-nix-action@v15+ with:+ extra_nix_config: |+ access-tokens = github.com=${{ secrets.GITHUB_TOKEN }}#{cachixConf (fromMaybe cachixTek cachix)}#{foldMap (cachixStep . cachixName) cachix}+ - name: 'build'+ run: nix build .#static+ - uses: 'marvinpinto/action-automatic-releases@latest'+ name: 'create release'+ with:+ repo_token: "${{ secrets.GITHUB_TOKEN }}"+ #{release}+ files: |+ result/bin/#{name}+|]++gaLatest ::+ ProjectName ->+ Branch ->+ Maybe Cachix ->+ Text+gaLatest name (Branch branch) cachix =+ ga name cachix "latest-release" [exon|branches:+ - '#{branch}'|] [exon|automatic_release_tag: 'latest'+ prerelease: true|]++gaTags ::+ ProjectName ->+ Maybe Cachix ->+ Text+gaTags name cachix =+ ga name cachix "tagged-release" [exon|tags:+ - '*'|] [exon|prerelease: false|]
+ lib/Ribosome/App/Templates/Hpack.hs view
@@ -0,0 +1,138 @@+module Ribosome.App.Templates.Hpack where++import Exon (exon)++import Ribosome.App.Data (+ Author (Author),+ Github (Github),+ GithubOrg (GithubOrg),+ GithubRepo (GithubRepo),+ Maintainer (Maintainer),+ ProjectName (ProjectName),+ Year (Year),+ )++githubField ::+ Github ->+ Text+githubField (Github (GithubOrg org) (GithubRepo repo)) =+ [exon|github = "#{repo}/#{org}";|]++hpackNix ::+ ProjectName ->+ Author ->+ Maintainer ->+ Year ->+ Maybe Github ->+ Text+hpackNix (ProjectName name) (Author author) (Maintainer maintainer) (Year year) github =+ [exon|{ config, lib, ... }:+with builtins;+with lib;+let++ mergeAttr = a: b:+ if isAttrs a+ then merge a b+ else if isList a+ then a ++ b+ else b;++ merge = l: r:+ let+ f = name:+ if hasAttr name l && hasAttr name r+ then mergeAttr l.${name} r.${name}+ else l.${name} or r.${name};+ in genAttrs (concatMap attrNames [l r]) f;++ paths = name: {+ when = {+ condition = false;+ generated-other-modules = ["Paths_${replaceStrings ["-"] ["_"] name}"];+ };+ };++ meta = {+ version = "0.1.0.0";+ license = "BSD-2-Clause-Patent";+ license-file = "LICENSE";+ author = "#{author}";+ maintainer = "#{maintainer}";+ copyright = "#{show year} #{author}";+ category = "Neovim";+ build-type = "Simple";+ #{foldMap (githubField) github}+ };++ base = {+ name = "base";+ version = ">= 4 && < 5";+ mixin = "hiding (Prelude)";+ };++ options.ghc-options = [+ "-Wall"+ "-Wredundant-constraints"+ "-Wincomplete-uni-patterns"+ "-Wmissing-deriving-strategies"+ "-Widentities"+ "-Wunused-packages"+ "-fplugin=Polysemy.Plugin"+ ];++ dependencies = [+ { name = "base"; version = ">= 4.12 && < 5"; mixin = "hiding (Prelude)"; }+ { name = "prelate"; version = ">= 0.1"; mixin = ["(Prelate as Prelude)" "hiding (Prelate)"]; }+ "polysemy"+ "polysemy-plugin"+ ];++ project = name: merge (meta // options) {+ inherit name;+ library = paths name // {+ source-dirs = "lib";+ inherit dependencies;+ };+ default-extensions = config.ghci.extensions;+ };++ exe = name: dir: merge (paths name // {+ main = "Main.hs";+ source-dirs = dir;+ inherit dependencies;+ ghc-options = [+ "-threaded"+ "-rtsopts"+ "-with-rtsopts=-N"+ ];+ });++in {++ #{name} = merge (project "#{name}") {+ synopsis = "A Neovim Plugin";+ description = "See https://hackage.haskell.org/package/#{name}/docs/#{name}.html";+ library.dependencies = [+ "ribosome"+ "ribosome-host"+ "ribosome-menu"+ ];+ executables.#{name} = exe "#{name}" "app" {+ dependencies = ["#{name}"];+ };+ tests.#{name}-unit = exe "#{name}" "test" {+ dependencies = [+ "#{name}"+ "polysemy-test"+ "ribosome"+ "ribosome-host"+ "ribosome-host-test"+ "ribosome-test"+ "tasty"+ ];+ };+ };++}+|]
+ lib/Ribosome/App/Templates/License.hs view
@@ -0,0 +1,42 @@+module Ribosome.App.Templates.License where++import Exon (exon)+import Ribosome.App.Data (Author (Author))++license :: Author -> Text+license (Author author) =+ [exon|Copyright (c) 2022 #{author}++Redistribution and use in source and binary forms, with or without modification, are permitted provided that the+following conditions are met:++ 1. Redistributions of source code must retain the above copyright notice, this list of conditions and the following+ disclaimer.+ 2. Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following+ disclaimer in the documentation and/or other materials provided with the distribution.++Subject to the terms and conditions of this license, each copyright holder and contributor hereby grants to those+receiving rights under this license a perpetual, worldwide, non-exclusive, no-charge, royalty-free, irrevocable (except+for failure to satisfy the conditions of this license) patent license to make, have made, use, offer to sell, sell,+import, and otherwise transfer this software, where such license applies only to those patent claims, already acquired+or hereafter acquired, licensable by such copyright holder or contributor that are necessarily infringed by:++ (a) their Contribution(s) (the licensed copyrights of copyright holders and non-copyrightable additions of+ contributors, in source or binary form) alone; or+ (b) combination of their Contribution(s) with the work of authorship to which such Contribution(s) was added by such+ copyright holder or contributor, if, at the time the Contribution is added, such addition causes such combination to+ be necessarily infringed. The patent license shall not apply to any other combinations which include the Contribution.++Except as expressly stated above, no rights or licenses from any copyright holder or contributor is granted under this+license, whether expressly, by implication, estoppel or otherwise.++DISCLAIMER++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES,+INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE+DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDERS OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR+SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,+WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF+THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.+|]
+ lib/Ribosome/App/Templates/MainHs.hs view
@@ -0,0 +1,12 @@+module Ribosome.App.Templates.MainHs where++import Exon (exon)++import Ribosome.App.Data (ModuleName (ModuleName))++mainHs :: ModuleName -> Text+mainHs (ModuleName modName) =+ [exon|module Main (main) where++import #{modName}.Plugin (main)+|]
+ lib/Ribosome/App/Templates/PingTestHs.hs view
@@ -0,0 +1,25 @@+module Ribosome.App.Templates.PingTestHs where++import Exon (exon)++import Ribosome.App.Data (ModuleName (ModuleName))++pingTestHs :: ModuleName -> Text+pingTestHs (ModuleName modName) =+ [exon|module #{modName}.Test.PingTest where++import Polysemy.Test (UnitTest, (===))+import Ribosome.Api (nvimCallFunction)+import Ribosome.Test (testPlugin)++import #{modName}.Plugin (#{modName}Stack, handlers, interpret#{modName}Stack)++test_ping :: UnitTest+test_ping =+ testPlugin @#{modName}Stack interpret#{modName}Stack handlers do+ r <- call *> call *> call+ (3 :: Int) === r+ where+ call =+ nvimCallFunction "#{modName}Ping" []+|]
+ lib/Ribosome/App/Templates/PluginHs.hs view
@@ -0,0 +1,54 @@+module Ribosome.App.Templates.PluginHs where++import Exon (exon)++import Ribosome.App.Data (ModuleName (ModuleName), ProjectName (ProjectName))++pluginHs :: ProjectName -> ModuleName -> Text+pluginHs (ProjectName name) (ModuleName modName) =+ [exon|module #{modName}.Plugin where++import Conc (interpretAtomic, withAsync_)+import Ribosome (+ Execution (Sync),+ Handler,+ RpcHandler,+ rpcFunction,+ runNvimPluginIO,+ )++type #{modName}Stack =+ '[+ AtomicState Int+ ]++ping ::+ Member (AtomicState Int) r =>+ Handler r Int+ping =+ atomicState' \ s -> (s + 1, s + 1)++handlers ::+ Member (AtomicState Int) r =>+ [RpcHandler r]+handlers =+ [+ rpcFunction "#{modName}Ping" Sync ping+ ]++prepare ::+ Sem r ()+prepare =+ unit++interpret#{modName}Stack ::+ Members [Resource, Race, Async, Embed IO] r =>+ InterpretersFor #{modName}Stack r+interpret#{modName}Stack sem =+ interpretAtomic 0 do+ withAsync_ prepare sem++main :: IO ()+main =+ runNvimPluginIO @#{modName}Stack "#{name}" interpret#{modName}Stack handlers+|]
+ lib/Ribosome/App/Templates/ReadmeMd.hs view
@@ -0,0 +1,50 @@+module Ribosome.App.Templates.ReadmeMd where++import Exon (exon)++import Ribosome.App.Data (Github (Github), ProjectName (ProjectName), GithubOrg (GithubOrg), GithubRepo (GithubRepo))++githubPlugin :: Github -> Text+githubPlugin (Github (GithubOrg org) (GithubRepo repo)) =+ [exon|+```vim+Plug '#{org}/#{repo}'+```|]++nix :: Text+nix =+ "[Nix package manager](https://nixos.org/learn.html)"++onlyBuild :: Text+onlyBuild =+ [exon|built using the #{nix}, which must be installed in the system.|]++githubFetch :: ProjectName -> Github -> Text+githubFetch (ProjectName name) _ =+ [exon|fetched or built on the first start.++* If the #{nix} is available, the plugin will be fetched from the Nix+ cache (or built if the current commit isn't in the cache)+* Otherwise it will be downloaded from Github's releases.+* If the variable `g:#{name}_fetch_bin` is set to `1`, Nix is ignored and the binary is downloaded from Github+ regardless.+|]++readmeMd ::+ ProjectName ->+ Maybe Github ->+ Text+readmeMd pn@(ProjectName name) github =+ [exon|# Intro+*#{name}* is a Neovim plugin.++# Install++The plugin can be loaded by specifying the repo to a package manager like any other, for example by cloning it in a+subdirectory of `'packpath'` or using one of the many plugin managers.+#{foldMap githubPlugin github}++Since the plugin is written in Haskell with the+[Ribosome](https://hackage.haskell.org/package/ribosome/docs/Ribosome.html) framework, its executable has to be+ #{maybe onlyBuild (githubFetch pn) github}+|]
+ lib/Ribosome/App/Templates/TestMainHs.hs view
@@ -0,0 +1,25 @@+module Ribosome.App.Templates.TestMainHs where++import Exon (exon)++import Ribosome.App.Data (ModuleName (ModuleName))++testMainHs :: ModuleName -> Text+testMainHs (ModuleName modName) =+ [exon|module Main where++import #{modName}.Test.PingTest (test_ping)+import Polysemy.Test (unitTest)+import Test.Tasty (TestTree, defaultMain, testGroup)++tests :: TestTree+tests =+ testGroup "all" [+ unitTest "ping" test_ping+ ]+++main :: IO ()+main =+ defaultMain tests+|]
+ lib/Ribosome/App/UserInput.hs view
@@ -0,0 +1,94 @@+module Ribosome.App.UserInput where++import qualified Data.Text.IO as Text+import Path (Path)+import Rainbow (+ Chunk,+ Radiant,+ blue,+ bold,+ chunk,+ color256,+ faint,+ fore,+ green,+ hPutChunks,+ hPutChunksLn,+ magenta,+ only256,+ yellow,+ )+import System.IO (getLine, stderr)++import Ribosome.App.Error (RainbowError, appError, outputError)+import Ribosome.Host.Path (pathText)++color :: Radiant -> Word8 -> Chunk -> Chunk+color r c =+ fore (r <> only256 (color256 c))++fbColor :: Radiant -> Word8 -> Chunk -> Chunk+fbColor r c =+ color r c . faint . bold++pathColor :: Chunk -> Chunk+pathColor =+ fbColor yellow 172++cmdColor :: Chunk -> Chunk+cmdColor =+ fbColor blue 111++pathChunk :: Path b t -> Chunk+pathChunk path =+ pathColor (chunk (pathText path))++neovimChunk :: Chunk+neovimChunk =+ fbColor green 76 "Neovim"++linkChunk :: Text -> Chunk+linkChunk =+ fbColor blue 33 . chunk++putStderr ::+ Member (Embed IO) r =>+ Text ->+ Sem r ()+putStderr =+ embed . Text.hPutStrLn stderr++infoMessage ::+ Members [Stop RainbowError, Embed IO] r =>+ [Chunk] ->+ Sem r ()+infoMessage cs =+ outputError (hPutChunksLn stderr (color magenta 55 (bold ">>= ") : cs))++askUser ::+ Eq a =>+ IsString a =>+ Members [Stop RainbowError, Embed IO] r =>+ Text ->+ Sem r (Maybe a)+askUser msg = do+ infoMessage [fore blue (chunk msg)]+ outputError (hPutChunks stderr ["✍️", fore magenta (bold " > ")])+ check . fromString <$> stopTryIOError (const ("" <> appError ["Aborted."])) getLine+ where+ check = \case+ "" -> Nothing+ a -> Just a++askRequired ::+ Eq a =>+ IsString a =>+ Members [Stop RainbowError, Embed IO] r =>+ Text ->+ Sem r a+askRequired msg =+ askUser msg >>= \case+ Just a -> pure a+ Nothing -> do+ infoMessage [fore magenta (faint "This option is mandatory.")]+ askRequired msg
+ ribosome-app.cabal view
@@ -0,0 +1,297 @@+cabal-version: 2.2++-- This file has been generated from package.yaml by hpack version 0.34.7.+--+-- see: https://github.com/sol/hpack++name: ribosome-app+version: 0.9.9.9+synopsis: CLI for Ribosome+description: See https://hackage.haskell.org/package/ribosome-app/docs/Ribosome.App.html+category: Neovim+author: Torsten Schmits+maintainer: hackage@tryp.io+copyright: 2022 Torsten Schmits+license: BSD-2-Clause-Patent+license-file: LICENSE+build-type: Simple++library+ exposed-modules:+ Ribosome.App.Boot+ Ribosome.App.Cli+ Ribosome.App.Data+ Ribosome.App.Data.TemplateTree+ Ribosome.App.Error+ Ribosome.App.NewOptions+ Ribosome.App.NewProject+ Ribosome.App.Options+ Ribosome.App.ProjectNames+ Ribosome.App.ProjectOptions+ Ribosome.App.ProjectPath+ Ribosome.App.Templates+ Ribosome.App.Templates.Boot+ Ribosome.App.Templates.Flake+ Ribosome.App.Templates.GithubActions+ Ribosome.App.Templates.Hpack+ Ribosome.App.Templates.License+ Ribosome.App.Templates.MainHs+ Ribosome.App.Templates.PingTestHs+ Ribosome.App.Templates.PluginHs+ Ribosome.App.Templates.ReadmeMd+ Ribosome.App.Templates.TestMainHs+ Ribosome.App.TemplateTree+ Ribosome.App.UserInput+ hs-source-dirs:+ lib+ default-extensions:+ AllowAmbiguousTypes+ ApplicativeDo+ BangPatterns+ BinaryLiterals+ BlockArguments+ ConstraintKinds+ DataKinds+ DefaultSignatures+ DeriveAnyClass+ DeriveDataTypeable+ DeriveFoldable+ DeriveFunctor+ DeriveGeneric+ DeriveLift+ DeriveTraversable+ DerivingStrategies+ DerivingVia+ DisambiguateRecordFields+ DoAndIfThenElse+ DuplicateRecordFields+ EmptyCase+ EmptyDataDecls+ ExistentialQuantification+ FlexibleContexts+ FlexibleInstances+ FunctionalDependencies+ GADTs+ GeneralizedNewtypeDeriving+ InstanceSigs+ KindSignatures+ LambdaCase+ LiberalTypeSynonyms+ MultiParamTypeClasses+ MultiWayIf+ NamedFieldPuns+ OverloadedLabels+ OverloadedLists+ OverloadedStrings+ PackageImports+ PartialTypeSignatures+ PatternGuards+ PatternSynonyms+ PolyKinds+ QuantifiedConstraints+ QuasiQuotes+ RankNTypes+ RecordWildCards+ RecursiveDo+ RoleAnnotations+ ScopedTypeVariables+ StandaloneDeriving+ TemplateHaskell+ TupleSections+ TypeApplications+ TypeFamilies+ TypeFamilyDependencies+ TypeOperators+ TypeSynonymInstances+ UndecidableInstances+ UnicodeSyntax+ ViewPatterns+ StandaloneKindSignatures+ OverloadedLabels+ ghc-options: -Wall -Wredundant-constraints -Wincomplete-uni-patterns -Wmissing-deriving-strategies -Widentities -Wunused-packages -fplugin=Polysemy.Plugin+ build-depends:+ base >=4.12 && <5+ , exon+ , optparse-applicative+ , path+ , path-io+ , polysemy+ , polysemy-chronos+ , polysemy-plugin+ , prelate >=0.1+ , rainbow+ , ribosome-host+ mixins:+ base hiding (Prelude)+ , prelate (Prelate as Prelude)+ , prelate hiding (Prelate)+ default-language: Haskell2010++executable ribosome+ main-is: Main.hs+ hs-source-dirs:+ app+ default-extensions:+ AllowAmbiguousTypes+ ApplicativeDo+ BangPatterns+ BinaryLiterals+ BlockArguments+ ConstraintKinds+ DataKinds+ DefaultSignatures+ DeriveAnyClass+ DeriveDataTypeable+ DeriveFoldable+ DeriveFunctor+ DeriveGeneric+ DeriveLift+ DeriveTraversable+ DerivingStrategies+ DerivingVia+ DisambiguateRecordFields+ DoAndIfThenElse+ DuplicateRecordFields+ EmptyCase+ EmptyDataDecls+ ExistentialQuantification+ FlexibleContexts+ FlexibleInstances+ FunctionalDependencies+ GADTs+ GeneralizedNewtypeDeriving+ InstanceSigs+ KindSignatures+ LambdaCase+ LiberalTypeSynonyms+ MultiParamTypeClasses+ MultiWayIf+ NamedFieldPuns+ OverloadedLabels+ OverloadedLists+ OverloadedStrings+ PackageImports+ PartialTypeSignatures+ PatternGuards+ PatternSynonyms+ PolyKinds+ QuantifiedConstraints+ QuasiQuotes+ RankNTypes+ RecordWildCards+ RecursiveDo+ RoleAnnotations+ ScopedTypeVariables+ StandaloneDeriving+ TemplateHaskell+ TupleSections+ TypeApplications+ TypeFamilies+ TypeFamilyDependencies+ TypeOperators+ TypeSynonymInstances+ UndecidableInstances+ UnicodeSyntax+ ViewPatterns+ StandaloneKindSignatures+ OverloadedLabels+ ghc-options: -Wall -Wredundant-constraints -Wincomplete-uni-patterns -Wmissing-deriving-strategies -Widentities -Wunused-packages -fplugin=Polysemy.Plugin -threaded -rtsopts -with-rtsopts=-N+ build-depends:+ base >=4.12 && <5+ , polysemy+ , polysemy-plugin+ , prelate >=0.1+ , ribosome-app+ mixins:+ base hiding (Prelude)+ , prelate (Prelate as Prelude)+ , prelate hiding (Prelate)+ default-language: Haskell2010++test-suite ribosome-app-unit+ type: exitcode-stdio-1.0+ main-is: Main.hs+ other-modules:+ Ribosome.App.Test.NewProjectTest+ hs-source-dirs:+ test+ default-extensions:+ AllowAmbiguousTypes+ ApplicativeDo+ BangPatterns+ BinaryLiterals+ BlockArguments+ ConstraintKinds+ DataKinds+ DefaultSignatures+ DeriveAnyClass+ DeriveDataTypeable+ DeriveFoldable+ DeriveFunctor+ DeriveGeneric+ DeriveLift+ DeriveTraversable+ DerivingStrategies+ DerivingVia+ DisambiguateRecordFields+ DoAndIfThenElse+ DuplicateRecordFields+ EmptyCase+ EmptyDataDecls+ ExistentialQuantification+ FlexibleContexts+ FlexibleInstances+ FunctionalDependencies+ GADTs+ GeneralizedNewtypeDeriving+ InstanceSigs+ KindSignatures+ LambdaCase+ LiberalTypeSynonyms+ MultiParamTypeClasses+ MultiWayIf+ NamedFieldPuns+ OverloadedLabels+ OverloadedLists+ OverloadedStrings+ PackageImports+ PartialTypeSignatures+ PatternGuards+ PatternSynonyms+ PolyKinds+ QuantifiedConstraints+ QuasiQuotes+ RankNTypes+ RecordWildCards+ RecursiveDo+ RoleAnnotations+ ScopedTypeVariables+ StandaloneDeriving+ TemplateHaskell+ TupleSections+ TypeApplications+ TypeFamilies+ TypeFamilyDependencies+ TypeOperators+ TypeSynonymInstances+ UndecidableInstances+ UnicodeSyntax+ ViewPatterns+ StandaloneKindSignatures+ OverloadedLabels+ ghc-options: -Wall -Wredundant-constraints -Wincomplete-uni-patterns -Wmissing-deriving-strategies -Widentities -Wunused-packages -fplugin=Polysemy.Plugin -threaded -rtsopts -with-rtsopts=-N+ build-depends:+ base >=4.12 && <5+ , chronos+ , path+ , polysemy+ , polysemy-plugin+ , polysemy-test+ , prelate >=0.1+ , ribosome-app+ , tasty+ mixins:+ base hiding (Prelude)+ , prelate (Prelate as Prelude)+ , prelate hiding (Prelate)+ default-language: Haskell2010
+ test/Main.hs view
@@ -0,0 +1,15 @@+module Main where++import Polysemy.Test (unitTest)+import Ribosome.App.Test.NewProjectTest (test_newProject)+import Test.Tasty (TestTree, defaultMain, testGroup)++tests :: TestTree+tests =+ testGroup "ribosome" [+ unitTest "create a new project" test_newProject+ ]++main :: IO ()+main =+ defaultMain tests
+ test/Ribosome/App/Test/NewProjectTest.hs view
@@ -0,0 +1,50 @@+module Ribosome.App.Test.NewProjectTest where++import qualified Chronos+import Chronos (datetimeToTime)+import qualified Data.Text as Text+import Path (reldir, relfile)+import Polysemy.Chronos (interpretTimeChronosConstant)+import qualified Polysemy.Test as Test+import Polysemy.Test (UnitTest, runTestAuto, (===))+import System.IO (stderr)+import Time (mkDatetime)++import Ribosome.App.Data (Cachix (Cachix), Github (Github), NewProject (..), PrintDir (PrintDir), Project (..))+import Ribosome.App.Error (runRainbowErrorAnd)+import Ribosome.App.NewOptions (defaultFlakeUrl)+import Ribosome.App.NewProject (newProject)+import qualified Ribosome.App.ProjectNames as ProjectNames++testTime :: Chronos.Time+testTime =+ datetimeToTime (mkDatetime 2300 1 1 12 0 0)++test_newProject :: UnitTest+test_newProject =+ runTestAuto $ interpretTimeChronosConstant testTime do+ dir <- Test.tempDir [reldir|new-project|]+ names <- fromEither (ProjectNames.parse "test-project")+ runRainbowErrorAnd stderr (fail "project generation failed") do+ newProject def NewProject {+ project = Project {+ names,+ directory = dir,+ branch = "main",+ github = Just (Github "org" "rep"),+ cachix = Just (Cachix "cach" "12345")+ },+ flakeUrl = defaultFlakeUrl,+ printDir = PrintDir False,+ author = "author",+ maintainer = "maintainer@home.page"+ }+ targetAction <- Test.fixtureLines [relfile|new-project/action.yml|]+ generatedAction <- Test.tempFileContent [relfile|new-project/.github/workflows/latest.yml|]+ targetAction === Text.lines generatedAction+ targetFlake <- Test.fixtureLines [relfile|new-project/flake.nix|]+ generatedFlake <- Test.tempFileContent [relfile|new-project/flake.nix|]+ targetFlake === Text.lines generatedFlake+ targetBoot <- Test.fixtureLines [relfile|new-project/boot.vim|]+ generatedBoot <- Test.tempFileContent [relfile|new-project/plugin/boot.vim|]+ targetBoot === Text.lines generatedBoot