Add gren format CLI subcommand

builder/src/Reporting/Exit.hs

@@ -17,6 +17,8 @@ module Reporting.Exit
     installToReport,
     Reactor (..),
     reactorToReport,
+    Format (..),
+    formatToReport,
     newPackageOverview,
     --
     Solver (..),
@@ -2448,3 +2450,45 @@ replToReport problem =
       corruptCacheReport
     ReplBlocked ->
       corruptCacheReport
+
+-- FORMAT
+
+data Format
+  = FormatPathUnknown FilePath
+  | FormatStdinWithFiles
+  | FormatNoOutline
+  | FormatBadOutline Outline
+
+formatToReport :: Format -> Help.Report
+formatToReport problem =
+  case problem of
+    FormatPathUnknown path ->
+      Help.report
+        "FILE NOT FOUND"
+        Nothing
+        "I cannot find this file:"
+        [ D.indent 4 $ D.red $ D.fromChars path,
+          D.reflow $ "Is there a typo?",
+          D.toSimpleNote $
+            "If you are just getting started, try working through the examples in the\
+            \ official guide https://guide.gren-lang.org to get an idea of the kinds of things\
+            \ that typically go in a src/Main.gren file."
+        ]
+    FormatStdinWithFiles ->
+      Help.report
+        "INCOMPATIBLE FLAGS"
+        Nothing
+        "Files and stdin cannot be formatted at the same time."
+        [ D.reflow "You'll need to run `gren format` two separate times if you want to do both."
+        ]
+    FormatNoOutline ->
+      Help.report
+        "FORMAT WHAT?"
+        Nothing
+        "I cannot find a gren.json so I am not sure what you want me to format.\
+        \ Normally you run `gren format` from within a project!"
+        [ D.reflow $ "If you need to format gren files outside of a project, tell me which files or directories to format:",
+          D.indent 4 $ D.green $ "gren format Example.gren"
+        ]
+    FormatBadOutline outline ->
+      toOutlineReport outline

compiler/src/Reporting/Doc.hs

@@ -26,6 +26,7 @@ module Reporting.Doc
     P.dullred,
     P.dullcyan,
     P.dullyellow,
+    P.dullwhite,
     --
     fromChars,
     fromName,

gren.cabal

@@ -54,6 +54,7 @@ Executable gren
     other-modules:
         Bump
         Diff
+        Format
         Init
         Install
         Make

terminal/impl/Terminal/Helpers.hs

@@ -3,6 +3,7 @@
 module Terminal.Helpers
   ( version,
     grenFile,
+    grenFileOrDirectory,
     package,
   )
 where
@@ -72,6 +73,18 @@ exampleGrenFiles :: String -> IO [String]
 exampleGrenFiles _ =
   return ["Main.gren", "src/Main.gren"]
 
+-- GREN FILE OR DIRECTORY
+
+grenFileOrDirectory :: Parser FilePath
+grenFileOrDirectory =
+  Parser
+    { _singular = "gren file or directory",
+      _plural = "gren files and/or directories",
+      _parser = Just,
+      _suggest = \_ -> return [],
+      _examples = \_ -> return ["Main.gren", "src/Examples/"]
+    }
+
 -- PACKAGE
 
 package :: Parser Pkg.Name

terminal/src/Format.hs

@@ -0,0 +1,158 @@
+{-# LANGUAGE OverloadedStrings #-}
+
+module Format
+  ( Flags (..),
+    run,
+  )
+where
+
+import qualified AbsoluteSrcDir
+import Control.Monad (filterM)
+import qualified Data.ByteString as BS
+import qualified Data.NonEmptyList as NE
+import qualified Directories as Dirs
+import qualified File
+import qualified Gren.Outline as Outline
+import qualified Reporting
+import qualified Reporting.Doc as D
+import qualified Reporting.Exit as Exit
+import qualified Reporting.Exit.Help as Help
+import qualified Reporting.Task as Task
+import qualified System.Directory as Dir
+import System.FilePath ((</>))
+
+-- FLAGS
+
+data Flags = Flags
+  { _skipPrompts :: Bool,
+    _stdin :: Bool
+  }
+
+-- RUN
+
+run :: [FilePath] -> Flags -> IO ()
+run paths flags =
+  Reporting.attempt Exit.formatToReport $
+    Task.run (format flags =<< getEnv paths flags)
+
+-- ENV
+
+data Env = Env
+  { _inputs :: Inputs
+  }
+
+data Inputs
+  = Stdin
+  | Files [FilePath]
+
+getEnv :: [FilePath] -> Flags -> Task.Task Exit.Format Env
+getEnv paths flags =
+  Env <$> (resolveInputPaths paths flags)
+
+resolveInputPaths :: [FilePath] -> Flags -> Task.Task Exit.Format Inputs
+resolveInputPaths paths flags =
+  case (_stdin flags, paths) of
+    (True, []) ->
+      return Stdin
+    (True, _ : _) ->
+      Task.throw Exit.FormatStdinWithFiles
+    (False, []) ->
+      Files <$> (resolveFiles =<< sourceDirsFromGrenJson)
+    (False, somePaths) ->
+      Files <$> (resolveFiles somePaths)
+
+sourceDirsFromGrenJson :: Task.Task Exit.Format [FilePath]
+sourceDirsFromGrenJson =
+  do
+    maybeRoot <- Task.io Dirs.findRoot
+    case maybeRoot of
+      Nothing ->
+        Task.throw Exit.FormatNoOutline
+      Just root ->
+        do
+          result <- Task.io $ Outline.read root
+          case result of
+            Left err ->
+              Task.throw $ Exit.FormatBadOutline err
+            Right outline ->
+              Task.io $
+                filterM Dir.doesDirectoryExist
+                  =<< ( traverse (fmap AbsoluteSrcDir.toFilePath <$> Outline.toAbsoluteSrcDir root) $
+                          (NE.toList (Outline.sourceDirs outline) ++ NE.toList (Outline.testDirs outline))
+                      )
+
+resolveFiles :: [FilePath] -> Task.Task Exit.Format [FilePath]
+resolveFiles paths =
+  concat <$> mapM resolveFile paths
+
+resolveFile :: FilePath -> Task.Task Exit.Format [FilePath]
+resolveFile path =
+  do
+    isDir <- Task.io (Dir.doesDirectoryExist path)
+    if isDir
+      then resolveFiles =<< Task.io (fmap (path </>) . filter (not . ignore) <$> Dir.listDirectory path)
+      else return [path]
+  where
+    ignore dir =
+      dir == ".gren"
+        || dir == "node_modules"
+        || dir == ".git"
+
+-- FORMAT
+
+format :: Flags -> Env -> Task.Task Exit.Format ()
+format flags (Env inputs) =
+  case inputs of
+    Stdin ->
+      do
+        original <- Task.io BS.getContents
+        let formatted = formatByteString original
+        Task.io $ BS.putStr formatted
+    Files paths ->
+      do
+        approved <-
+          if not (_skipPrompts flags)
+            then Task.io $ Reporting.ask (confirmFormat paths)
+            else return True
+        if approved
+          then mapM_ formatFile paths
+          else do
+            Task.io $ putStrLn "Okay, I did not change anything!"
+            return ()
+
+confirmFormat :: [FilePath] -> D.Doc
+confirmFormat paths =
+  D.stack
+    [ D.reflow "This will overwrite the following files to use Gren's preferred style:",
+      D.indent 4 $ D.vcat (fmap D.fromChars paths),
+      D.reflow "This cannot be undone! Make sure to back up these files before proceeding.",
+      D.reflow
+        "Are you sure you want to overwrite these files with formatted versions? [Y/n]: "
+    ]
+
+formatFile :: FilePath -> Task.Task Exit.Format ()
+formatFile path =
+  do
+    exists <- Task.io (Dir.doesFileExist path)
+    if exists
+      then do
+        Task.io (formatExistingFile path)
+      else Task.throw (Exit.FormatPathUnknown path)
+
+formatExistingFile :: FilePath -> IO ()
+formatExistingFile path =
+  do
+    putStr ("Formatting " ++ path)
+    original <- File.readUtf8 path
+    let formatted = formatByteString original
+    if formatted == original
+      then do
+        Help.toStdout (" " <> D.dullwhite "(no changes)" <> "\n")
+      else do
+        File.writeUtf8 path formatted
+        Help.toStdout (" " <> D.green "CHANGED" <> "\n")
+
+formatByteString :: BS.ByteString -> BS.ByteString
+formatByteString original =
+  -- TODO: implement actual formating
+  original

terminal/src/Main.hs

@@ -8,6 +8,7 @@ where
 import qualified Bump
 import qualified Data.List as List
 import qualified Diff
+import qualified Format
 import qualified Gren.Version as V
 import qualified Init
 import qualified Install
@@ -30,6 +31,7 @@ main =
       init,
       make,
       install,
+      format,
       bump,
       diff,
       publish
@@ -248,6 +250,22 @@ diff =
           ]
    in Terminal.Command "diff" Uncommon details example diffArgs noFlags Diff.run
 
+-- FORMAT
+
+format :: Terminal.Command
+format =
+  let details =
+        "The `format` command rewrites .gren files to use Gren's preferred style:"
+
+      example =
+        reflow "If no files or directories are given, all .gren files in all source and test directories will be formatted."
+
+      formatFlags =
+        flags Format.Flags
+          |-- onOff "yes" "Assume yes for all interactive prompts."
+          |-- onOff "stdin" "Format stdin and write it to stdout."
+   in Terminal.Command "format" Uncommon details example (zeroOrMore grenFileOrDirectory) formatFlags Format.run
+
 -- HELPERS
 
 stack :: [P.Doc] -> P.Doc