From 215609cdc4f692db816312f24bc286ca85a623e0 Mon Sep 17 00:00:00 2001 From: Aaron VonderHaar Date: Sat, 23 Apr 2022 19:07:53 -0700 Subject: [PATCH 1/3] Expose Outline source directories --- builder/src/AbsoluteSrcDir.hs | 25 +++++++++++++++++++++++++ builder/src/Build.hs | 32 ++++++++------------------------ builder/src/Gren/Outline.hs | 21 +++++++++++++++++++++ gren.cabal | 1 + 4 files changed, 55 insertions(+), 24 deletions(-) create mode 100644 builder/src/AbsoluteSrcDir.hs diff --git a/builder/src/AbsoluteSrcDir.hs b/builder/src/AbsoluteSrcDir.hs new file mode 100644 index 000000000..9e6420831 --- /dev/null +++ b/builder/src/AbsoluteSrcDir.hs @@ -0,0 +1,25 @@ +module AbsoluteSrcDir + ( AbsoluteSrcDir (..), + mkAbsoluteSrcDir, + addRelative, + toFilePath, + ) +where + +import qualified System.Directory as Dir +import System.FilePath (()) + +newtype AbsoluteSrcDir + = AbsoluteSrcDir FilePath + +toFilePath :: AbsoluteSrcDir -> FilePath +toFilePath (AbsoluteSrcDir path) = path + +mkAbsoluteSrcDir :: FilePath -> IO AbsoluteSrcDir +mkAbsoluteSrcDir srcDir = + AbsoluteSrcDir + <$> Dir.canonicalizePath srcDir + +addRelative :: AbsoluteSrcDir -> FilePath -> FilePath +addRelative (AbsoluteSrcDir srcDir) path = + srcDir path diff --git a/builder/src/Build.hs b/builder/src/Build.hs index 95637994f..c6cbc315e 100644 --- a/builder/src/Build.hs +++ b/builder/src/Build.hs @@ -20,6 +20,8 @@ where import qualified AST.Canonical as Can import qualified AST.Optimized as Opt import qualified AST.Source as Src +import AbsoluteSrcDir (AbsoluteSrcDir (..)) +import qualified AbsoluteSrcDir import qualified Compile import Control.Concurrent (forkIO) import Control.Concurrent.MVar @@ -75,31 +77,13 @@ makeEnv key root (Details.Details _ validOutline buildID locals foreigns _) = case validOutline of Details.ValidApp givenSrcDirs -> do - srcDirs <- traverse (toAbsoluteSrcDir root) (NE.toList givenSrcDirs) + srcDirs <- traverse (Outline.toAbsoluteSrcDir root) (NE.toList givenSrcDirs) return $ Env key root Parse.Application srcDirs buildID locals foreigns Details.ValidPkg pkg _ _ -> do - srcDir <- toAbsoluteSrcDir root (Outline.RelativeSrcDir "src") + srcDir <- Outline.toAbsoluteSrcDir root (Outline.RelativeSrcDir "src") return $ Env key root (Parse.Package pkg) [srcDir] buildID locals foreigns --- SOURCE DIRECTORY - -newtype AbsoluteSrcDir - = AbsoluteSrcDir FilePath - -toAbsoluteSrcDir :: FilePath -> Outline.SrcDir -> IO AbsoluteSrcDir -toAbsoluteSrcDir root srcDir = - AbsoluteSrcDir - <$> Dir.canonicalizePath - ( case srcDir of - Outline.AbsoluteSrcDir dir -> dir - Outline.RelativeSrcDir dir -> root dir - ) - -addRelative :: AbsoluteSrcDir -> FilePath -> FilePath -addRelative (AbsoluteSrcDir srcDir) path = - srcDir path - -- FORK -- PERF try using IORef semephore on file crawl phase? @@ -242,7 +226,7 @@ crawlModule env@(Env _ root projectType srcDirs buildID locals foreigns) mvar do do let fileName = ModuleName.toFilePath name <.> "gren" - paths <- filterM File.exists (map (`addRelative` fileName) srcDirs) + paths <- filterM File.exists (map (`AbsoluteSrcDir.addRelative` fileName) srcDirs) case paths of [path] -> @@ -899,8 +883,8 @@ getRootInfoHelp (Env _ _ _ srcDirs _ _ _) path absolutePath = case matchingDirs of d1 : d2 : _ -> do - let p1 = addRelative d1 (FP.joinPath names <.> "gren") - let p2 = addRelative d2 (FP.joinPath names <.> "gren") + let p1 = AbsoluteSrcDir.addRelative d1 (FP.joinPath names <.> "gren") + let p2 = AbsoluteSrcDir.addRelative d2 (FP.joinPath names <.> "gren") return $ Left $ Exit.BP_RootNameDuplicate name p1 p2 _ -> return $ Right $ RootInfo absolutePath path (LInside name) @@ -911,7 +895,7 @@ getRootInfoHelp (Env _ _ _ srcDirs _ _ _) path absolutePath = isInsideSrcDirByName :: [String] -> AbsoluteSrcDir -> IO Bool isInsideSrcDirByName names srcDir = - File.exists (addRelative srcDir (FP.joinPath names <.> "gren")) + File.exists (AbsoluteSrcDir.addRelative srcDir (FP.joinPath names <.> "gren")) isInsideSrcDirByPath :: [String] -> AbsoluteSrcDir -> Maybe (FilePath, Either [String] [String]) isInsideSrcDirByPath segments (AbsoluteSrcDir srcDir) = diff --git a/builder/src/Gren/Outline.hs b/builder/src/Gren/Outline.hs index 89aec76a0..d8148a426 100644 --- a/builder/src/Gren/Outline.hs +++ b/builder/src/Gren/Outline.hs @@ -14,9 +14,14 @@ module Gren.Outline decoder, defaultSummary, flattenExposed, + toAbsoluteSrcDir, + sourceDirs, + testDirs, ) where +import AbsoluteSrcDir (AbsoluteSrcDir) +import qualified AbsoluteSrcDir import Control.Monad (filterM, liftM) import Data.Binary (Binary, get, getWord8, put, putWord8) import qualified Data.Map as Map @@ -204,6 +209,10 @@ toAbsolute root srcDir = AbsoluteSrcDir dir -> dir RelativeSrcDir dir -> root dir +toAbsoluteSrcDir :: FilePath -> SrcDir -> IO AbsoluteSrcDir +toAbsoluteSrcDir root srcDir = + AbsoluteSrcDir.mkAbsoluteSrcDir (toAbsolute root srcDir) + detectDuplicates :: FilePath -> [SrcDir] -> IO (Maybe (FilePath, (FilePath, FilePath))) detectDuplicates root srcDirs = do @@ -225,6 +234,18 @@ isDup paths = OneOrMore.One _ -> Nothing OneOrMore.More a b -> Just (OneOrMore.getFirstTwo a b) +sourceDirs :: Outline -> NE.List SrcDir +sourceDirs outline = + case outline of + App (AppOutline _ srcDirs _ _ _ _) -> + srcDirs + Pkg _ -> + NE.singleton (RelativeSrcDir "src") + +testDirs :: Outline -> NE.List SrcDir +testDirs _ = + NE.singleton (RelativeSrcDir "tests") + -- JSON DECODE type Decoder a = diff --git a/gren.cabal b/gren.cabal index 8deb0da3e..830ff1e17 100644 --- a/gren.cabal +++ b/gren.cabal @@ -68,6 +68,7 @@ Executable gren Terminal.Internal -- from builder/ + AbsoluteSrcDir Build BackgroundWriter Deps.Diff From 3ca9e3e58ef57a152180cede1c7eee9779049161 Mon Sep 17 00:00:00 2001 From: Aaron VonderHaar Date: Sun, 24 Apr 2022 18:03:21 -0700 Subject: [PATCH 2/3] Add gren format CLI subcommand --- builder/src/Reporting/Exit.hs | 44 +++++++++ compiler/src/Reporting/Doc.hs | 1 + gren.cabal | 1 + terminal/impl/Terminal/Helpers.hs | 13 +++ terminal/src/Format.hs | 158 ++++++++++++++++++++++++++++++ terminal/src/Main.hs | 18 ++++ 6 files changed, 235 insertions(+) create mode 100644 terminal/src/Format.hs diff --git a/builder/src/Reporting/Exit.hs b/builder/src/Reporting/Exit.hs index 632dca4fe..ecc736a98 100644 --- a/builder/src/Reporting/Exit.hs +++ b/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 diff --git a/compiler/src/Reporting/Doc.hs b/compiler/src/Reporting/Doc.hs index 43af53c66..f07b923dc 100644 --- a/compiler/src/Reporting/Doc.hs +++ b/compiler/src/Reporting/Doc.hs @@ -26,6 +26,7 @@ module Reporting.Doc P.dullred, P.dullcyan, P.dullyellow, + P.dullwhite, -- fromChars, fromName, diff --git a/gren.cabal b/gren.cabal index 830ff1e17..59827b5e4 100644 --- a/gren.cabal +++ b/gren.cabal @@ -54,6 +54,7 @@ Executable gren other-modules: Bump Diff + Format Init Install Make diff --git a/terminal/impl/Terminal/Helpers.hs b/terminal/impl/Terminal/Helpers.hs index f440b3f15..f1d606156 100644 --- a/terminal/impl/Terminal/Helpers.hs +++ b/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 diff --git a/terminal/src/Format.hs b/terminal/src/Format.hs new file mode 100644 index 000000000..3852e8c5f --- /dev/null +++ b/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 diff --git a/terminal/src/Main.hs b/terminal/src/Main.hs index d23d2311a..1c88e1b65 100644 --- a/terminal/src/Main.hs +++ b/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 From 897b8e6616383b07ba4693659f7a0207ffa45ec7 Mon Sep 17 00:00:00 2001 From: Aaron VonderHaar Date: Sun, 24 Apr 2022 22:52:57 -0700 Subject: [PATCH 3/3] Rename mkAbsoluteSrcDir -> AbsoluteSrcDir.fromFilePath --- builder/src/AbsoluteSrcDir.hs | 6 +++--- builder/src/Gren/Outline.hs | 2 +- 2 files changed, 4 insertions(+), 4 deletions(-) diff --git a/builder/src/AbsoluteSrcDir.hs b/builder/src/AbsoluteSrcDir.hs index 9e6420831..1e9ca51a4 100644 --- a/builder/src/AbsoluteSrcDir.hs +++ b/builder/src/AbsoluteSrcDir.hs @@ -1,6 +1,6 @@ module AbsoluteSrcDir ( AbsoluteSrcDir (..), - mkAbsoluteSrcDir, + fromFilePath, addRelative, toFilePath, ) @@ -15,8 +15,8 @@ newtype AbsoluteSrcDir toFilePath :: AbsoluteSrcDir -> FilePath toFilePath (AbsoluteSrcDir path) = path -mkAbsoluteSrcDir :: FilePath -> IO AbsoluteSrcDir -mkAbsoluteSrcDir srcDir = +fromFilePath :: FilePath -> IO AbsoluteSrcDir +fromFilePath srcDir = AbsoluteSrcDir <$> Dir.canonicalizePath srcDir diff --git a/builder/src/Gren/Outline.hs b/builder/src/Gren/Outline.hs index d8148a426..e60f81e86 100644 --- a/builder/src/Gren/Outline.hs +++ b/builder/src/Gren/Outline.hs @@ -211,7 +211,7 @@ toAbsolute root srcDir = toAbsoluteSrcDir :: FilePath -> SrcDir -> IO AbsoluteSrcDir toAbsoluteSrcDir root srcDir = - AbsoluteSrcDir.mkAbsoluteSrcDir (toAbsolute root srcDir) + AbsoluteSrcDir.fromFilePath (toAbsolute root srcDir) detectDuplicates :: FilePath -> [SrcDir] -> IO (Maybe (FilePath, (FilePath, FilePath))) detectDuplicates root srcDirs =