From f8a23399c0598f4254854bc21934b83528f08518 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?R=C3=A9mi=20Lef=C3=A8vre?= Date: Sun, 1 Dec 2019 19:53:03 +0100 Subject: [PATCH] Auto-detect elm version per file Resolves #561 --- elm-format.cabal | 2 + src/ElmFormat.hs | 175 +++++++++++------------- src/ElmFormat/Execute.hs | 7 +- src/ElmFormat/FileStore.hs | 12 +- src/ElmFormat/Filesystem.hs | 104 +++++++++++--- src/ElmFormat/Operation.hs | 1 + src/ElmFormat/World.hs | 14 +- src/Messages/Formatter/HumanReadable.hs | 4 +- src/Messages/Formatter/Json.hs | 17 ++- src/Messages/Types.hs | 2 +- tests/ElmFormat/TestWorld.hs | 23 +++- tests/Integration/CliTest.hs | 7 + 12 files changed, 221 insertions(+), 147 deletions(-) diff --git a/elm-format.cabal b/elm-format.cabal index 0450b4351..c4b39fdb5 100644 --- a/elm-format.cabal +++ b/elm-format.cabal @@ -119,6 +119,7 @@ library bytestring >= 0.10.8.2 && < 0.11, containers >= 0.6.0.1 && < 0.7, directory >= 1.3.3.0 && < 2, + exceptions >= 0.10.1 && < 0.11, filepath >= 1.4.2.1 && < 2, free >= 5.1.1 && < 6, indents >= 0.3.3 && < 0.4, @@ -180,6 +181,7 @@ test-Suite elm-format-tests Util.ListTest build-depends: + filepath >= 1.4.2.1 && < 2, tasty >= 1.2 && < 2, tasty-golden >= 2.3.2 && < 3, tasty-hunit >= 0.10.0.1 && < 0.11, diff --git a/src/ElmFormat.hs b/src/ElmFormat.hs index 316eaddcc..3dee6a425 100644 --- a/src/ElmFormat.hs +++ b/src/ElmFormat.hs @@ -11,6 +11,7 @@ import Control.Monad.Free import qualified CommandLine.Helpers as Helpers import ElmVersion import ElmFormat.FileStore (FileStore) +import ElmFormat.Filesystem (ElmFile) import ElmFormat.FileWriter (FileWriter) import ElmFormat.InputConsole (InputConsole) import ElmFormat.OutputConsole (OutputConsole) @@ -19,6 +20,7 @@ import ElmFormat.World import qualified AST.Json import qualified AST.Module import qualified Flags +import qualified Data.Maybe as Maybe import qualified Data.Text as Text import qualified ElmFormat.Execute as Execute import qualified ElmFormat.InputConsole as InputConsole @@ -34,18 +36,21 @@ import qualified Reporting.Result as Result import qualified Text.JSON -resolveFile :: FileStore f => FilePath -> Free f (Either InputFileMessage [FilePath]) -resolveFile path = +resolveFile :: FileStore f => ElmVersion -> FilePath -> Free f (Either InputFileMessage [ElmFile]) +resolveFile defaultElmVersion path = do - fileType <- FileStore.stat path + upwardElmVersion <- FS.findElmVersion path + let elmFile = FS.ElmFile (Maybe.fromMaybe defaultElmVersion upwardElmVersion) path + fileType <- FileStore.stat path case fileType of FileStore.IsFile -> - return $ Right [path] + do + return $ Right [elmFile] FileStore.IsDirectory -> do - elmFiles <- FS.findAllElmFiles path + elmFiles <- FS.findAllElmFiles elmFile case elmFiles of [] -> return $ Left $ NoElmFiles path _ -> return $ Right elmFiles @@ -74,32 +79,32 @@ collectErrors list = foldl step (Right []) list -resolveFiles :: FileStore f => [FilePath] -> Free f (Either [InputFileMessage] [FilePath]) -resolveFiles inputFiles = +resolveFiles :: FileStore f => ElmVersion -> [FilePath] -> Free f (Either [InputFileMessage] [ElmFile]) +resolveFiles defaultElmVersion inputFiles = do - result <- collectErrors <$> mapM resolveFile inputFiles + result <- collectErrors <$> mapM (resolveFile defaultElmVersion) inputFiles case result of Left ls -> return $ Left ls Right files -> - return $ Right $ concat files + return $ Right $ concat $ files data WhatToDo - = FormatToFile FilePath FilePath - | StdinToFile FilePath - | FormatInPlace FilePath [FilePath] - | StdinToStdout - | ValidateStdin - | ValidateFiles FilePath [FilePath] - | FileToJson FilePath - | StdinToJson + = FormatToFile ElmFile FilePath + | StdinToFile ElmVersion FilePath + | FormatInPlace ElmFile [ElmFile] + | StdinToStdout ElmVersion + | ValidateStdin ElmVersion + | ValidateFiles ElmFile [ElmFile] + | FileToJson ElmFile + | StdinToJson ElmVersion data Source - = Stdin - | FromFiles FilePath [FilePath] + = Stdin ElmVersion + | FromFiles ElmFile [ElmFile] data Destination @@ -109,16 +114,33 @@ data Destination | ToJson -determineSource :: Bool -> Either [InputFileMessage] [FilePath] -> Either ErrorMessage Source -determineSource stdin inputFiles = +determineSource :: Bool -> Bool -> Maybe ElmVersion -> ElmVersion -> Either [InputFileMessage] [ElmFile] -> Either ErrorMessage Source +determineSource stdin upgrade versionFlag defaultElmVersion inputFiles = + let + determineFile (FS.ElmFile fileDetectedVersion path) = + FS.ElmFile (upgradeVersion upgrade $ Maybe.fromMaybe fileDetectedVersion versionFlag) path + in case ( stdin, inputFiles ) of ( _, Left fileErrors ) -> Left $ BadInputFiles fileErrors - ( True, Right [] ) -> Right Stdin + ( True, Right [] ) -> Right $ Stdin $ upgradeVersion upgrade $ Maybe.fromMaybe defaultElmVersion versionFlag ( False, Right [] ) -> Left NoInputs - ( False, Right (first:rest) ) -> Right $ FromFiles first rest + ( False, Right (first:rest) ) -> Right $ FromFiles (determineFile first) (fmap determineFile rest) ( True, Right (_:_) ) -> Left TooManyInputs +upgradeVersion :: Bool -> ElmVersion -> ElmVersion +upgradeVersion upgrade version = + case (upgrade, version) of + (True, Elm_0_18) -> + Elm_0_18_Upgrade + + (True, Elm_0_19) -> + Elm_0_19_Upgrade + + _ -> + version + + determineDestination :: Maybe FilePath -> Bool -> Bool -> Either ErrorMessage Destination determineDestination output doValidate json = case ( output, doValidate, json ) of @@ -133,11 +155,11 @@ determineDestination output doValidate json = determineWhatToDo :: Source -> Destination -> Either ErrorMessage WhatToDo determineWhatToDo source destination = case ( source, destination ) of - ( Stdin, ValidateOnly ) -> Right $ ValidateStdin + ( Stdin version, ValidateOnly ) -> Right $ ValidateStdin version ( FromFiles first rest, ValidateOnly) -> Right $ ValidateFiles first rest - ( Stdin, UpdateInPlace ) -> Right StdinToStdout - ( Stdin, ToJson ) -> Right StdinToJson - ( Stdin, ToFile output ) -> Right $ StdinToFile output + ( Stdin version, UpdateInPlace ) -> Right $ StdinToStdout version + ( Stdin version, ToJson ) -> Right $ StdinToJson version + ( Stdin version, ToFile output ) -> Right $ StdinToFile version output ( FromFiles first [], ToFile output ) -> Right $ FormatToFile first output ( FromFiles first rest, UpdateInPlace ) -> Right $ FormatInPlace first rest ( FromFiles _ _, ToFile _ ) -> Left SingleOutputWithMultipleInputs @@ -145,10 +167,10 @@ determineWhatToDo source destination = ( FromFiles _ _, ToJson ) -> Left SingleOutputWithMultipleInputs -determineWhatToDoFromConfig :: Flags.Config -> Either [InputFileMessage] [FilePath] -> Either ErrorMessage WhatToDo -determineWhatToDoFromConfig config resolvedInputFiles = +determineWhatToDoFromConfig :: Flags.Config -> ElmVersion -> Either [InputFileMessage] [ElmFile] -> Either ErrorMessage WhatToDo +determineWhatToDoFromConfig config defaultElmVersion resolvedInputFiles = do - source <- determineSource (Flags._stdin config) resolvedInputFiles + source <- determineSource (Flags._stdin config) (Flags._upgrade config) (Flags._elmVersion config) defaultElmVersion resolvedInputFiles destination <- determineDestination (Flags._output config) (Flags._validate config) (Flags._json config) determineWhatToDo source destination @@ -159,22 +181,6 @@ exitWithError message = >> exitFailure -determineVersion :: ElmVersion -> Bool -> Either ErrorMessage ElmVersion -determineVersion elmVersion upgrade = - case (elmVersion, upgrade) of - (Elm_0_18, True) -> - Right Elm_0_18_Upgrade - - (Elm_0_19, True) -> - Right Elm_0_19_Upgrade - - (_, True) -> - Left $ MustSpecifyVersionWithUpgrade Elm_0_19_Upgrade - - (_, False) -> - Right elmVersion - - elmFormatVersion :: String elmFormatVersion = ElmFormat.Version.asString @@ -222,9 +228,11 @@ main'' elmFormatVersion_ experimental_ args = Just config -> do let autoYes = Flags._yes config - resolvedInputFiles <- Execute.run (Execute.forHuman autoYes) $ resolveFiles (Flags._input config) + currentDirectoryElmVersion <- Execute.run (Execute.forHuman autoYes) $ FS.findElmVersion "." + let defaultElmVersion = Maybe.fromMaybe Elm_0_19 currentDirectoryElmVersion; + resolvedInputFiles <- Execute.run (Execute.forHuman autoYes) $ resolveFiles defaultElmVersion (Flags._input config) - case determineWhatToDoFromConfig config resolvedInputFiles of + case determineWhatToDoFromConfig config defaultElmVersion resolvedInputFiles of Left NoInputs -> (handleParseResult $ Flags.showHelpText elmFormatVersion_ experimental_) -- TODO: handleParseResult is exitSuccess, so we never get to exitFailure @@ -233,45 +241,15 @@ main'' elmFormatVersion_ experimental_ args = Left message -> exitWithError message - Right whatToDo -> do - elmVersionChoice <- case Flags._elmVersion config of - Just v -> return $ Right v - Nothing -> autoDetectElmVersion - - case elmVersionChoice of - Left message -> - putStr message *> exitFailure - - Right elmVersionChoice' -> do - let elmVersionResult = determineVersion elmVersionChoice' (Flags._upgrade config) - - case elmVersionResult of - Left message -> - exitWithError message - - Right elmVersion -> - do - let run = case (Flags._validate config) of - True -> Execute.run $ Execute.forMachine elmVersion True - False -> Execute.run $ Execute.forHuman autoYes - result <- run $ doIt elmVersion whatToDo - if result - then exitSuccess - else exitFailure - - -autoDetectElmVersion :: World m => m (Either String ElmVersion) -autoDetectElmVersion = - do - hasElmPackageJson <- doesFileExist "elm-package.json" - if hasElmPackageJson - then - do - hasElmJson <- doesFileExist "elm.json" - if hasElmJson - then return $ Right Elm_0_19 - else return $ Right Elm_0_18 - else return $ Right Elm_0_19 + Right whatToDo -> + do + let run = case (Flags._validate config) of + True -> Execute.run $ Execute.forMachine True + False -> Execute.run $ Execute.forHuman autoYes + result <- run $ doIt whatToDo + if result + then exitSuccess + else exitFailure validate :: ElmVersion -> (FilePath, Text.Text) -> Either InfoMessage () @@ -279,7 +257,7 @@ validate elmVersion (inputFile, inputText) = case Parse.parse elmVersion inputText of Result.Result _ (Result.Ok modu) -> if inputText /= Render.render elmVersion modu then - Left $ FileWouldChange inputFile + Left $ FileWouldChange inputFile elmVersion else Right () @@ -363,35 +341,36 @@ logErrorOr fn result = fn value *> return True -doIt :: (InputConsole f, OutputConsole f, InfoFormatter f, FileStore f, FileWriter f) => ElmVersion -> WhatToDo -> Free f Bool -doIt elmVersion whatToDo = + +doIt :: (InputConsole f, OutputConsole f, InfoFormatter f, FileStore f, FileWriter f) => WhatToDo -> Free f Bool +doIt whatToDo = case whatToDo of - ValidateStdin -> + ValidateStdin elmVersion -> (validate elmVersion <$> readStdin) >>= logError ValidateFiles first rest -> all id <$> mapM validateFile (first:rest) - where validateFile file = (validate elmVersion <$> ElmFormat.readFile file) >>= logError + where validateFile (FS.ElmFile elmVersion path) = (validate elmVersion <$> ElmFormat.readFile path) >>= logError - StdinToStdout -> + StdinToStdout elmVersion -> (fmap getOutputText <$> format elmVersion <$> readStdin) >>= logErrorOr OutputConsole.writeStdout - StdinToFile outputFile -> + StdinToFile elmVersion outputFile -> (fmap getOutputText <$> format elmVersion <$> readStdin) >>= logErrorOr (FileWriter.overwriteFile outputFile) - FormatToFile inputFile outputFile -> + FormatToFile (FS.ElmFile elmVersion inputFile) outputFile -> (fmap getOutputText <$> format elmVersion <$> ElmFormat.readFile inputFile) >>= logErrorOr (FileWriter.overwriteFile outputFile) FormatInPlace first rest -> do - canOverwrite <- approve $ FilesWillBeOverwritten (first:rest) + canOverwrite <- approve $ FilesWillBeOverwritten $ fmap FS.path (first:rest) if canOverwrite then all id <$> mapM formatFile (first:rest) else return True where - formatFile file = (format elmVersion <$> ElmFormat.readFile file) >>= logErrorOr ElmFormat.updateFile + formatFile (FS.ElmFile elmVersion path) = (format elmVersion <$> ElmFormat.readFile path) >>= logErrorOr ElmFormat.updateFile - StdinToJson -> + StdinToJson elmVersion -> (fmap (Text.pack . Text.JSON.encode . AST.Json.showModule) <$> parseModule elmVersion <$> readStdin) >>= logErrorOr OutputConsole.writeStdout -- TODO: this prints "Processing such-and-such-a-file.elm" which makes the JSON output invalid diff --git a/src/ElmFormat/Execute.hs b/src/ElmFormat/Execute.hs index 4b202b293..620a986df 100644 --- a/src/ElmFormat/Execute.hs +++ b/src/ElmFormat/Execute.hs @@ -11,7 +11,6 @@ import Control.Monad.State import Control.Monad.Free import ElmFormat.Operation import ElmFormat.World -import ElmVersion import qualified ElmFormat.FileStore as FileStore import qualified ElmFormat.FileWriter as FileWriter @@ -59,14 +58,14 @@ forHuman autoYes = {-| Execute Operations in a fashion appropriate for use by automated scripts. -} -forMachine :: World m => ElmVersion -> Bool -> Program m OperationF Bool -forMachine elmVersion autoYes = +forMachine :: World m => Bool -> Program m OperationF Bool +forMachine autoYes = Program { init = Json.init , step = \operation -> case operation of InFileStore op -> lift $ FileStore.execute op - InInfoFormatter op -> Json.format elmVersion autoYes op + InInfoFormatter op -> Json.format autoYes op InInputConsole op -> lift $ InputConsole.execute op InOutputConsole op -> lift $ OutputConsole.execute op InFileWriter op -> lift $ FileWriter.execute op diff --git a/src/ElmFormat/FileStore.hs b/src/ElmFormat/FileStore.hs index a7a2d9218..ed614bdd8 100644 --- a/src/ElmFormat/FileStore.hs +++ b/src/ElmFormat/FileStore.hs @@ -1,9 +1,9 @@ -module ElmFormat.FileStore (FileStore, FileStoreF(..), FileType(..), readFile, stat, listDirectory, execute) where +module ElmFormat.FileStore (FileStore, FileStoreF(..), FileType(..), readFile, stat, listDirectory, makeAbsolute, execute) where import Prelude hiding (readFile, writeFile) import Control.Monad.Free import Data.Text (Text) -import ElmFormat.World hiding (readFile, listDirectory) +import ElmFormat.World hiding (readFile, listDirectory, makeAbsolute) import qualified ElmFormat.World as World @@ -17,30 +17,35 @@ class Functor f => FileStore f where readFile :: FilePath -> f Text stat :: FilePath -> f FileType listDirectory :: FilePath -> f [FilePath] + makeAbsolute :: FilePath -> f FilePath data FileStoreF a = ReadFile FilePath (Text -> a) | Stat FilePath (FileType -> a) | ListDirectory FilePath ([FilePath] -> a) + | MakeAbsolute FilePath (FilePath -> a) instance Functor FileStoreF where fmap f (ReadFile path a) = ReadFile path (f . a) fmap f (Stat path a) = Stat path (f . a) fmap f (ListDirectory path a) = ListDirectory path (f . a) + fmap f (MakeAbsolute path a) = MakeAbsolute path (f . a) instance FileStore FileStoreF where readFile path = ReadFile path id stat path = Stat path id listDirectory path = ListDirectory path id + makeAbsolute path = MakeAbsolute path id instance FileStore f => FileStore (Free f) where readFile path = liftF (readFile path) stat path = liftF (stat path) listDirectory path = liftF (listDirectory path) + makeAbsolute path = liftF (makeAbsolute path) execute :: World m => FileStoreF a -> m a @@ -60,3 +65,6 @@ execute operation = ListDirectory path next -> next <$> World.listDirectory path + + MakeAbsolute path next -> + next <$> World.makeAbsolute path diff --git a/src/ElmFormat/Filesystem.hs b/src/ElmFormat/Filesystem.hs index abe8d9735..3453cbd29 100644 --- a/src/ElmFormat/Filesystem.hs +++ b/src/ElmFormat/Filesystem.hs @@ -2,10 +2,20 @@ module ElmFormat.Filesystem where import Control.Monad.Free import ElmFormat.FileStore -import System.FilePath (()) +import ElmVersion +import System.FilePath ((), takeDirectory) + +import qualified Data.Maybe as Maybe import qualified System.FilePath as FilePath +data ElmFile + = ElmFile + { version :: ElmVersion + , path :: FilePath + } deriving (Show) + + collectFiles :: Monad m => (a -> m [a]) -> a -> m [a] collectFiles children root = do @@ -14,9 +24,12 @@ collectFiles children root = return $ root : concat subChildren -listDir :: FileStore f => FilePath -> Free f [FilePath] -listDir path = - map (path ) <$> listDirectory path +listDir :: FileStore f => ElmFile -> Free f [ElmFile] +listDir (ElmFile upwardVersion path) = + do + version <- findDirectoryElmVersion path SingleDirectory + let version' = Maybe.fromMaybe upwardVersion version + fmap (ElmFile version' . (path )) <$> listDirectory path doesDirectoryExist :: FileStore f => FilePath -> Free f Bool @@ -28,38 +41,85 @@ doesDirectoryExist path = _ -> return False -fileList :: FileStore f => FilePath -> Free f [FilePath] +fileList :: FileStore f => ElmFile -> Free f [ElmFile] fileList = - let - children path = - if isSkippable path then - return [] - else - do - directory <- doesDirectoryExist path - if directory then listDir path else return [] - in - collectFiles children - - -isSkippable :: FilePath -> Bool -isSkippable path = + let + children dir = + if isSkippable dir then + return [] + else + do + directory <- doesDirectoryExist (path dir) + if directory then listDir dir else return [] + in + collectFiles children + + +isSkippable :: ElmFile -> Bool +isSkippable (ElmFile _ path) = or [ hasFilename "elm-stuff" path , hasFilename "node_modules" path , hasFilename ".git" path ] -hasExtension :: String -> FilePath -> Bool -hasExtension ext path = +hasExtension :: String -> ElmFile -> Bool +hasExtension ext (ElmFile _ path) = ext == FilePath.takeExtension path -findAllElmFiles :: FileStore f => FilePath -> Free f [FilePath] +findAllElmFiles :: FileStore f => ElmFile -> Free f [ElmFile] findAllElmFiles inputFile = filter (hasExtension ".elm") <$> fileList inputFile +findElmVersion :: FileStore f => FilePath -> Free f (Maybe ElmVersion) +findElmVersion path = + do + fileType <- stat path + case fileType of + IsFile -> + do + absoluteDir <- makeAbsolute $ takeDirectory path + findDirectoryElmVersion absoluteDir Recursive + + IsDirectory -> + do + absoluteDir <- makeAbsolute path + findDirectoryElmVersion absoluteDir Recursive + + _ -> + return Nothing + + +data ElmVersionFinder + = SingleDirectory + | Recursive + + +findDirectoryElmVersion :: FileStore f => FilePath -> ElmVersionFinder -> Free f (Maybe ElmVersion) +findDirectoryElmVersion dir finder = + do + let upwardDir = takeDirectory dir + elmJson <- stat (dir "elm.json") + case elmJson of + IsFile -> + return $ Just Elm_0_19 + + _ -> + do + elmPackageJson <- stat (dir "elm-package.json") + case (elmPackageJson, finder) of + (IsFile, _) -> + return $ Just Elm_0_18 + + (_, Recursive) | dir /= upwardDir -> + findDirectoryElmVersion upwardDir Recursive + + _ -> + return Nothing + + hasFilename :: String -> FilePath -> Bool hasFilename name path = name == FilePath.takeFileName path diff --git a/src/ElmFormat/Operation.hs b/src/ElmFormat/Operation.hs index a209986ad..88dff202b 100644 --- a/src/ElmFormat/Operation.hs +++ b/src/ElmFormat/Operation.hs @@ -27,6 +27,7 @@ instance FileStore OperationF where readFile path = InFileStore $ readFile path stat path = InFileStore $ stat path listDirectory path = InFileStore $ listDirectory path + makeAbsolute path = InFileStore $ makeAbsolute path instance InfoFormatter OperationF where diff --git a/src/ElmFormat/World.hs b/src/ElmFormat/World.hs index 460e0a914..348db86e5 100644 --- a/src/ElmFormat/World.hs +++ b/src/ElmFormat/World.hs @@ -1,11 +1,13 @@ module ElmFormat.World where +import Control.Exception import Data.Text (Text) import System.Console.ANSI (SGR, hSetSGR) import System.IO (hFlush, hPutStr, hPutStrLn, stdout, stderr) import qualified Data.ByteString as ByteString import qualified Data.ByteString.Char8 as Char8 import qualified Data.ByteString.Lazy as Lazy +import qualified Data.Either as Either import qualified Data.Text.Encoding as Text import qualified System.Directory as Dir import qualified System.Environment @@ -21,6 +23,7 @@ class Monad m => World m where doesFileExist :: FilePath -> m Bool doesDirectoryExist :: FilePath -> m Bool listDirectory :: FilePath -> m [FilePath] + makeAbsolute :: FilePath -> m FilePath getProgName :: m String @@ -44,9 +47,16 @@ instance World IO where writeFile = Prelude.writeFile writeUtf8File path content = ByteString.writeFile path $ Text.encodeUtf8 content - doesFileExist = Dir.doesFileExist - doesDirectoryExist = Dir.doesDirectoryExist + doesFileExist path = do + exists <- try (Dir.doesFileExist path) :: IO (Either IOException Bool) + return $ Either.fromRight False exists + + doesDirectoryExist path = do + exists <- try (Dir.doesDirectoryExist path) :: IO (Either IOException Bool) + return $ Either.fromRight False exists + listDirectory = Dir.listDirectory + makeAbsolute = Dir.makeAbsolute getProgName = System.Environment.getProgName diff --git a/src/Messages/Formatter/HumanReadable.hs b/src/Messages/Formatter/HumanReadable.hs index a2ba1aa56..d8ea9ad4d 100644 --- a/src/Messages/Formatter/HumanReadable.hs +++ b/src/Messages/Formatter/HumanReadable.hs @@ -41,8 +41,8 @@ renderInfo :: World m => InfoMessage -> m () renderInfo (ProcessingFile file) = putStrLn $ "Processing file " ++ file -renderInfo (FileWouldChange file) = - putStrLn $ "File would be changed " ++ file +renderInfo (FileWouldChange file version) = + putStrLn $ "File would be changed " ++ file ++ " (" ++ show version ++ ")" renderInfo (ParseError inputFile inputText errs) = showErrors inputFile inputText errs diff --git a/src/Messages/Formatter/Json.hs b/src/Messages/Formatter/Json.hs index 62e1cec30..3e8a4dca8 100644 --- a/src/Messages/Formatter/Json.hs +++ b/src/Messages/Formatter/Json.hs @@ -7,15 +7,14 @@ import Prelude hiding (init, putStr, putStrLn) import Control.Monad.State import Messages.Formatter.Format import Messages.Types -import ElmVersion (ElmVersion) import ElmFormat.World -format :: World m => ElmVersion -> Bool -> InfoFormatterF a -> StateT Bool m a -format elmVersion autoYes infoFormatter = +format :: World m => Bool -> InfoFormatterF a -> StateT Bool m a +format autoYes infoFormatter = case infoFormatter of OnInfo info next -> - showInfo elmVersion info next + showInfo info next Approve _prompt next -> case autoYes of @@ -33,17 +32,17 @@ done = putStrLn "]" -showInfo :: World m => ElmVersion -> InfoMessage -> a -> StateT Bool m a +showInfo :: World m => InfoMessage -> a -> StateT Bool m a -showInfo _ (ProcessingFile _) next = +showInfo (ProcessingFile _) next = return next -showInfo elmVersion (FileWouldChange file) next = +showInfo (FileWouldChange file fileVersion) next = json next file $ "File is not formatted with elm-format-" ++ ElmFormat.Version.asString - ++ " --elm-version=" ++ show elmVersion + ++ " --elm-version=" ++ show fileVersion -showInfo _ (ParseError inputFile _ _) next = +showInfo (ParseError inputFile _ _) next = json next inputFile "Error parsing the file" diff --git a/src/Messages/Types.hs b/src/Messages/Types.hs index 5697751b5..b1a8c5dfc 100644 --- a/src/Messages/Types.hs +++ b/src/Messages/Types.hs @@ -9,7 +9,7 @@ import qualified Reporting.Error.Syntax as Syntax data InfoMessage = ProcessingFile FilePath - | FileWouldChange FilePath + | FileWouldChange FilePath ElmVersion | ParseError FilePath String [A.Located Syntax.Error] diff --git a/tests/ElmFormat/TestWorld.hs b/tests/ElmFormat/TestWorld.hs index d40b02104..a20a5c834 100644 --- a/tests/ElmFormat/TestWorld.hs +++ b/tests/ElmFormat/TestWorld.hs @@ -14,6 +14,7 @@ import qualified Data.Map.Strict as Dict import qualified Data.Text.Lazy as Text import qualified Data.Text.Lazy.Encoding as Text import qualified Data.Text as StrictText +import qualified System.FilePath as FilePath data TestWorldState = @@ -43,20 +44,28 @@ fullStderr state = |> reverse |> concat - +{-| Files paths are normalized to allow: + - "./elm-package.json" and "package.json" for example to point to the same file + (this is required for Elm version autodetection to work correctly in tests) + - POSIX paths like "src/test.elm" to also work on Windows in tests +-} instance World (State.State TestWorldState) where doesFileExist path = do state <- State.get - return $ Dict.member path (filesystem state) + return $ Dict.member (FilePath.normalise path) (filesystem state) doesDirectoryExist _path = return False + makeAbsolute path = + -- wrong but enough for tests + return path + readFile path = do state <- State.get - case Dict.lookup path (filesystem state) of + case Dict.lookup (FilePath.normalise path) (filesystem state) of Nothing -> error $ path ++ ": does not exist" @@ -71,7 +80,7 @@ instance World (State.State TestWorldState) where writeFile path content = do state <- State.get - State.put $ state { filesystem = Dict.insert path content (filesystem state) } + State.put $ state { filesystem = Dict.insert (FilePath.normalise path) content (filesystem state) } writeUtf8File path content = writeFile path (StrictText.unpack content) @@ -152,7 +161,7 @@ assertOutput :: [(String, String)] -> TestWorldState -> Assertion assertOutput expectedFiles context = assertBool ("Expected filesystem to contain: " ++ show expectedFiles ++ "\nActual: " ++ show (filesystem context)) - (all (\(k,v) -> Dict.lookup k (filesystem context) == Just v) expectedFiles) + (all (\(k,v) -> Dict.lookup (FilePath.normalise k) (filesystem context) == Just v) expectedFiles) goldenStdout :: String -> FilePath -> TestWorldState -> TestTree @@ -187,12 +196,12 @@ init = testWorld [] uploadFile :: String -> String -> TestWorld -> TestWorld uploadFile name content world = - world { filesystem = Dict.insert name content (filesystem world) } + world { filesystem = Dict.insert (FilePath.normalise name) content (filesystem world) } downloadFile :: String -> TestWorld -> Maybe String downloadFile name world = - Dict.lookup name (filesystem world) + Dict.lookup (FilePath.normalise name) (filesystem world) installProgram :: String -> ([String] -> State.State TestWorld ()) -> TestWorld -> TestWorld diff --git a/tests/Integration/CliTest.hs b/tests/Integration/CliTest.hs index 02116ae6c..fd5d145fd 100644 --- a/tests/Integration/CliTest.hs +++ b/tests/Integration/CliTest.hs @@ -46,6 +46,13 @@ tests = |> TestWorld.uploadFile "elm-package.json" "{\"elm-version\": \"0.18.0 <= v < 0.19.0\"}" |> run "elm-format" ["test.elm", "--validate"] |> expectExit 0 + , testCase "for mixed Elm 0.18 and 0.19" $ world + |> TestWorld.uploadFile "0.18/src/test.elm" "module Main exposing (f)\n\n\nf =\n '\\x2000'\n" + |> TestWorld.uploadFile "0.18/elm-package.json" "{\"elm-version\": \"0.18.0 <= v < 0.19.0\"}" + |> TestWorld.uploadFile "0.19/src/test.elm" "module Main exposing (f)\n\n\nf =\n '\\u{2000}'\n" + |> TestWorld.uploadFile "0.19/elm.json" "{\"elm-version\": \"0.19.0 <= v < 0.20.0\"}" + |> run "elm-format" ["0.18/src/test.elm", "0.19/src/test.elm", "--validate"] + |> expectExit 0 , testCase "default to Elm 0.19" $ world |> TestWorld.uploadFile "test.elm" "module Main exposing (f)\n\n\nf =\n '\\u{2000}'\n" |> run "elm-format" ["test.elm", "--validate"]