Skip to content

Commit

Permalink
Auto-detect elm version per file
Browse files Browse the repository at this point in the history 
Resolves avh4#561
  • Loading branch information
@rlefevre
rlefevre committed Dec 2, 2019
1 parent 3b2a0fd commit c09e060
Show file tree
Hide file tree
Showing 12 changed files with 231 additions and 147 deletions.
2 changes: 2 additions & 0 deletions elm-format.cabal
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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,
Expand Down Expand Up @@ -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,
Expand Down
185 changes: 87 additions & 98 deletions src/ElmFormat.hs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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)
Expand All @@ -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
Expand All @@ -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
Expand Down Expand Up @@ -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
Expand All @@ -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_Upgrade

_ ->
version


determineDestination :: Maybe FilePath -> Bool -> Bool -> Either ErrorMessage Destination
determineDestination output doValidate json =
case ( output, doValidate, json ) of
Expand All @@ -133,48 +155,42 @@ 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
( FromFiles first [], ToJson ) -> Right $ FileToJson first
( 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
checkUpgradeVersion (Flags._upgrade config) (Flags._elmVersion config)
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


checkUpgradeVersion :: Bool -> Maybe ElmVersion -> Either ErrorMessage ()
checkUpgradeVersion upgrade elmVersionFlag =
case (upgrade, elmVersionFlag) of
(True, Just Elm_0_18) -> Right ()
(True, Just Elm_0_19) -> Right ()
(True, _) -> Left $ MustSpecifyVersionWithUpgrade Elm_0_19_Upgrade
(False, _) -> Right ()


exitWithError :: World m => ErrorMessage -> m ()
exitWithError message =
(putStrLnStderr $ Helpers.r $ 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
Expand Down Expand Up @@ -222,9 +238,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
Expand All @@ -233,53 +251,23 @@ 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 ()
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 ()

Expand Down Expand Up @@ -363,35 +351,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
Expand Down
7 changes: 3 additions & 4 deletions src/ElmFormat/Execute.hs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down Expand Up @@ -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
Expand Down
Loading

0 comments on commit c09e060

Please sign in to comment.