Skip to content

Commit

Permalink
Auto-detect elm version per file
Browse files Browse the repository at this point in the history
Resolves #561
  • Loading branch information
rlefevre committed Nov 26, 2019
1 parent 3b2a0fd commit 15f3458
Show file tree
Hide file tree
Showing 6 changed files with 96 additions and 61 deletions.
1 change: 1 addition & 0 deletions elm-format.cabal
Original file line number Diff line number Diff line change
Expand Up @@ -180,6 +180,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,
Expand Down
103 changes: 49 additions & 54 deletions src/ElmFormat.hs
Original file line number Diff line number Diff line change
Expand Up @@ -34,18 +34,21 @@ import qualified Reporting.Result as Result
import qualified Text.JSON


resolveFile :: FileStore f => FilePath -> Free f (Either InputFileMessage [FilePath])
resolveFile :: FileStore f => FilePath -> Free f (Either InputFileMessage [ElmFile])
resolveFile path =
do
fileType <- FileStore.stat path

case fileType of
FileStore.IsFile ->
return $ Right [path]
do
elmFile <- FS.addElmVersion path
return $ Right [elmFile]

FileStore.IsDirectory ->
do
elmFiles <- FS.findAllElmFiles path
files <- FS.findAllElmFiles path
elmFiles <- sequence $ fmap FS.addElmVersion files
case elmFiles of
[] -> return $ Left $ NoElmFiles path
_ -> return $ Right elmFiles
Expand Down Expand Up @@ -74,7 +77,7 @@ collectErrors list =
foldl step (Right []) list


resolveFiles :: FileStore f => [FilePath] -> Free f (Either [InputFileMessage] [FilePath])
resolveFiles :: FileStore f => [FilePath] -> Free f (Either [InputFileMessage] [ElmFile])
resolveFiles inputFiles =
do
result <- collectErrors <$> mapM resolveFile inputFiles
Expand All @@ -83,23 +86,26 @@ resolveFiles inputFiles =
return $ Left ls

Right files ->
return $ Right $ concat files
return $ Right $ concat $ files


type ElmFile
= (FilePath, ElmVersion)

data WhatToDo
= FormatToFile FilePath FilePath
= FormatToFile ElmFile FilePath
| StdinToFile FilePath
| FormatInPlace FilePath [FilePath]
| FormatInPlace ElmFile [ElmFile]
| StdinToStdout
| ValidateStdin
| ValidateFiles FilePath [FilePath]
| FileToJson FilePath
| ValidateFiles ElmFile [ElmFile]
| FileToJson ElmFile
| StdinToJson


data Source
= Stdin
| FromFiles FilePath [FilePath]
| FromFiles ElmFile [ElmFile]


data Destination
Expand All @@ -109,7 +115,7 @@ data Destination
| ToJson


determineSource :: Bool -> Either [InputFileMessage] [FilePath] -> Either ErrorMessage Source
determineSource :: Bool -> Either [InputFileMessage] [ElmFile] -> Either ErrorMessage Source
determineSource stdin inputFiles =
case ( stdin, inputFiles ) of
( _, Left fileErrors ) -> Left $ BadInputFiles fileErrors
Expand Down Expand Up @@ -145,7 +151,7 @@ determineWhatToDo source destination =
( FromFiles _ _, ToJson ) -> Left SingleOutputWithMultipleInputs


determineWhatToDoFromConfig :: Flags.Config -> Either [InputFileMessage] [FilePath] -> Either ErrorMessage WhatToDo
determineWhatToDoFromConfig :: Flags.Config -> Either [InputFileMessage] [(FilePath, ElmVersion)] -> Either ErrorMessage WhatToDo
determineWhatToDoFromConfig config resolvedInputFiles =
do
source <- determineSource (Flags._stdin config) resolvedInputFiles
Expand Down Expand Up @@ -223,6 +229,7 @@ main'' elmFormatVersion_ experimental_ args =
do
let autoYes = Flags._yes config
resolvedInputFiles <- Execute.run (Execute.forHuman autoYes) $ resolveFiles (Flags._input config)
detectedElmVersion <- Execute.run (Execute.forHuman autoYes) $ ElmVersion.fromFile "."

case determineWhatToDoFromConfig config resolvedInputFiles of
Left NoInputs ->
Expand All @@ -234,44 +241,24 @@ main'' elmFormatVersion_ experimental_ args =
exitWithError message

Right whatToDo -> do
elmVersionChoice <- case Flags._elmVersion config of
Just v -> return $ Right v
Nothing -> autoDetectElmVersion
let elmVersionChoice = case Flags._elmVersion config of
Just v -> v
Nothing -> detectedElmVersion

case elmVersionChoice of
let elmVersionResult = determineVersion elmVersionChoice (Flags._upgrade config)
case elmVersionResult of
Left message ->
putStr message *> exitFailure

Right elmVersionChoice' -> do
let elmVersionResult = determineVersion elmVersionChoice' (Flags._upgrade config)
exitWithError message

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 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 config whatToDo
if result
then exitSuccess
else exitFailure


validate :: ElmVersion -> (FilePath, Text.Text) -> Either InfoMessage ()
Expand Down Expand Up @@ -363,33 +350,41 @@ 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) => ElmVersion -> Flags.Config -> WhatToDo -> Free f Bool
doIt elmVersion config whatToDo =
let
getVersion fileDetectedElmVersion =
case (Flags._upgrade config, Flags._elmVersion config) of
(True, _) -> elmVersion
(False, Just v) -> v
(False, Nothing) -> fileDetectedElmVersion
in
case whatToDo of
ValidateStdin ->
(validate elmVersion <$> readStdin) >>= logError

ValidateFiles first rest ->
all id <$> mapM validateFile (first:rest)
where validateFile file = (validate elmVersion <$> ElmFormat.readFile file) >>= logError
where validateFile (file, fileElmVersion) = (validate (getVersion fileElmVersion) <$> ElmFormat.readFile file) >>= logError

StdinToStdout ->
(fmap getOutputText <$> format elmVersion <$> readStdin) >>= logErrorOr OutputConsole.writeStdout

StdinToFile outputFile ->
(fmap getOutputText <$> format elmVersion <$> readStdin) >>= logErrorOr (FileWriter.overwriteFile outputFile)

FormatToFile inputFile outputFile ->
(fmap getOutputText <$> format elmVersion <$> ElmFormat.readFile inputFile) >>= logErrorOr (FileWriter.overwriteFile outputFile)
FormatToFile (inputFile, fileElmVersion) outputFile ->
(fmap getOutputText <$> format (getVersion fileElmVersion) <$> ElmFormat.readFile inputFile) >>= logErrorOr (FileWriter.overwriteFile outputFile)

FormatInPlace first rest ->
do
canOverwrite <- approve $ FilesWillBeOverwritten (first:rest)
canOverwrite <- approve $ FilesWillBeOverwritten $ fmap fst $ (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 (file, fileElmVersion) = (format (getVersion fileElmVersion) <$> ElmFormat.readFile file) >>= logErrorOr ElmFormat.updateFile

StdinToJson ->
(fmap (Text.pack . Text.JSON.encode . AST.Json.showModule) <$> parseModule elmVersion <$> readStdin) >>= logErrorOr OutputConsole.writeStdout
Expand Down
5 changes: 5 additions & 0 deletions src/ElmFormat/Filesystem.hs
Original file line number Diff line number Diff line change
Expand Up @@ -3,6 +3,7 @@ module ElmFormat.Filesystem where
import Control.Monad.Free
import ElmFormat.FileStore
import System.FilePath ((</>))
import ElmVersion
import qualified System.FilePath as FilePath


Expand Down Expand Up @@ -63,3 +64,7 @@ findAllElmFiles inputFile =
hasFilename :: String -> FilePath -> Bool
hasFilename name path =
name == FilePath.takeFileName path

addElmVersion :: FileStore f => FilePath -> Free f (FilePath, ElmVersion)
addElmVersion path =
fmap ((,) path) $ ElmVersion.fromFile path
22 changes: 22 additions & 0 deletions src/ElmVersion.hs
Original file line number Diff line number Diff line change
@@ -1,6 +1,9 @@
{-# OPTIONS_GHC -Wall #-}
module ElmVersion where

import Control.Monad.Free
import System.FilePath ((</>), takeDirectory)
import ElmFormat.FileStore

data ElmVersion
= Elm_0_16 -- TODO: remove 0_16
Expand Down Expand Up @@ -58,3 +61,22 @@ style_0_19_cannotExposeOpenListing elmVersion =
Elm_0_18 -> False
Elm_0_18_Upgrade -> False
_ -> True

fromFile :: FileStore f => FilePath -> Free f ElmVersion
fromFile path =
do
let dir = takeDirectory (path)
elmPackageJson <- stat (path </> "elm-package.json")
case elmPackageJson of
IsFile ->
do
elmJson <- stat (path </> "elm.json")
return $ case elmJson of
IsFile -> Elm_0_19
_ -> Elm_0_18

_ | path == dir ->
return Elm_0_19

_ ->
fromFile $ dir
19 changes: 12 additions & 7 deletions tests/ElmFormat/TestWorld.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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 =
Expand Down Expand Up @@ -43,20 +44,24 @@ 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

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"

Expand All @@ -71,7 +76,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)
Expand Down Expand Up @@ -152,7 +157,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
Expand Down Expand Up @@ -187,12 +192,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
Expand Down
7 changes: 7 additions & 0 deletions tests/Integration/CliTest.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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"]
Expand Down

0 comments on commit 15f3458

Please sign in to comment.