1{-# OPTIONS_GHC -Wall #-} 2module ElmFormat where 3 4import Prelude hiding (putStr, putStrLn) 5 6import System.Exit (ExitCode(..)) 7import System.Environment (getArgs) 8import Messages.Types 9import Messages.Formatter.Format 10import Control.Monad.Free 11import qualified CommandLine.Helpers as Helpers 12import ElmVersion 13import ElmFormat.FileStore (FileStore) 14import ElmFormat.FileWriter (FileWriter) 15import ElmFormat.InputConsole (InputConsole) 16import ElmFormat.OutputConsole (OutputConsole) 17import ElmFormat.World 18 19import qualified AST.Json 20import qualified AST.Module 21import qualified Flags 22import qualified Data.Text as Text 23import qualified ElmFormat.Execute as Execute 24import qualified ElmFormat.InputConsole as InputConsole 25import qualified ElmFormat.Parse as Parse 26import qualified ElmFormat.Render.Text as Render 27import qualified ElmFormat.FileStore as FileStore 28import qualified ElmFormat.FileWriter as FileWriter 29import qualified ElmFormat.Filesystem as FS 30import qualified ElmFormat.OutputConsole as OutputConsole 31import qualified ElmFormat.Version 32import qualified Options.Applicative as Opt 33import qualified Reporting.Result as Result 34import qualified Text.JSON 35 36 37resolveFile :: FileStore f => FilePath -> Free f (Either InputFileMessage [FilePath]) 38resolveFile path = 39 do 40 fileType <- FileStore.stat path 41 42 case fileType of 43 FileStore.IsFile -> 44 return $ Right [path] 45 46 FileStore.IsDirectory -> 47 do 48 elmFiles <- FS.findAllElmFiles path 49 case elmFiles of 50 [] -> return $ Left $ NoElmFiles path 51 _ -> return $ Right elmFiles 52 53 FileStore.DoesNotExist -> 54 return $ Left $ FileDoesNotExist path 55 56 57collectErrors :: [Either l r] -> Either [l] [r] 58collectErrors list = 59 let 60 step acc next = 61 case (next, acc) of 62 (Left l, Right _) -> 63 Left [l] 64 65 (Left l, Left ls) -> 66 Left (l : ls) 67 68 (Right r, Right rs) -> 69 Right (r : rs) 70 71 (Right _, Left ls) -> 72 Left ls 73 in 74 foldl step (Right []) list 75 76 77resolveFiles :: FileStore f => [FilePath] -> Free f (Either [InputFileMessage] [FilePath]) 78resolveFiles inputFiles = 79 do 80 result <- collectErrors <$> mapM resolveFile inputFiles 81 case result of 82 Left ls -> 83 return $ Left ls 84 85 Right files -> 86 return $ Right $ concat files 87 88 89data WhatToDo 90 = FormatToFile FilePath FilePath 91 | StdinToFile FilePath 92 | FormatInPlace FilePath [FilePath] 93 | StdinToStdout 94 | ValidateStdin 95 | ValidateFiles FilePath [FilePath] 96 | FileToJson FilePath 97 | StdinToJson 98 99 100data Source 101 = Stdin 102 | FromFiles FilePath [FilePath] 103 104 105data Destination 106 = ValidateOnly 107 | UpdateInPlace 108 | ToFile FilePath 109 | ToJson 110 111 112determineSource :: Bool -> Either [InputFileMessage] [FilePath] -> Either ErrorMessage Source 113determineSource stdin inputFiles = 114 case ( stdin, inputFiles ) of 115 ( _, Left fileErrors ) -> Left $ BadInputFiles fileErrors 116 ( True, Right [] ) -> Right Stdin 117 ( False, Right [] ) -> Left NoInputs 118 ( False, Right (first:rest) ) -> Right $ FromFiles first rest 119 ( True, Right (_:_) ) -> Left TooManyInputs 120 121 122determineDestination :: Maybe FilePath -> Bool -> Bool -> Either ErrorMessage Destination 123determineDestination output doValidate json = 124 case ( output, doValidate, json ) of 125 ( _, True, True ) -> Left OutputAndValidate 126 ( Nothing, True, False ) -> Right ValidateOnly 127 ( Nothing, False, False ) -> Right UpdateInPlace 128 ( Just path, False, False ) -> Right $ ToFile path 129 ( Just _, True, _ ) -> Left OutputAndValidate 130 ( _, False, True ) -> Right ToJson 131 132 133determineWhatToDo :: Source -> Destination -> Either ErrorMessage WhatToDo 134determineWhatToDo source destination = 135 case ( source, destination ) of 136 ( Stdin, ValidateOnly ) -> Right $ ValidateStdin 137 ( FromFiles first rest, ValidateOnly) -> Right $ ValidateFiles first rest 138 ( Stdin, UpdateInPlace ) -> Right StdinToStdout 139 ( Stdin, ToJson ) -> Right StdinToJson 140 ( Stdin, ToFile output ) -> Right $ StdinToFile output 141 ( FromFiles first [], ToFile output ) -> Right $ FormatToFile first output 142 ( FromFiles first rest, UpdateInPlace ) -> Right $ FormatInPlace first rest 143 ( FromFiles _ _, ToFile _ ) -> Left SingleOutputWithMultipleInputs 144 ( FromFiles first [], ToJson ) -> Right $ FileToJson first 145 ( FromFiles _ _, ToJson ) -> Left SingleOutputWithMultipleInputs 146 147 148determineWhatToDoFromConfig :: Flags.Config -> Either [InputFileMessage] [FilePath] -> Either ErrorMessage WhatToDo 149determineWhatToDoFromConfig config resolvedInputFiles = 150 do 151 source <- determineSource (Flags._stdin config) resolvedInputFiles 152 destination <- determineDestination (Flags._output config) (Flags._validate config) (Flags._json config) 153 determineWhatToDo source destination 154 155 156exitWithError :: World m => ErrorMessage -> m () 157exitWithError message = 158 (putStrLnStderr $ Helpers.r $ message) 159 >> exitFailure 160 161 162determineVersion :: ElmVersion -> Bool -> Either ErrorMessage ElmVersion 163determineVersion elmVersion upgrade = 164 case (elmVersion, upgrade) of 165 (Elm_0_18, True) -> 166 Right Elm_0_18_Upgrade 167 168 (Elm_0_19, True) -> 169 Right Elm_0_19_Upgrade 170 171 (_, True) -> 172 Left $ MustSpecifyVersionWithUpgrade Elm_0_19_Upgrade 173 174 (_, False) -> 175 Right elmVersion 176 177 178elmFormatVersion :: String 179elmFormatVersion = 180 ElmFormat.Version.asString 181 182 183experimental :: Maybe String 184experimental = 185 ElmFormat.Version.experimental 186 187 188{-| copied from Options.Applicative -} 189handleParseResult :: World m => Opt.ParserResult a -> m (Maybe a) 190handleParseResult (Opt.Success a) = return (Just a) 191handleParseResult (Opt.Failure failure) = do 192 progn <- getProgName 193 let (msg, exit) = Opt.renderFailure failure progn 194 case exit of 195 ExitSuccess -> putStrLn msg *> exitSuccess *> return Nothing 196 _ -> putStrLnStderr msg *> exitFailure *> return Nothing 197handleParseResult (Opt.CompletionInvoked _) = do 198 -- progn <- getProgName 199 -- msg <- Opt.execCompletion compl progn 200 -- putStr msg 201 -- const undefined <$> exitSuccess 202 error "Shell completion not yet implemented" 203 204 205main :: IO () 206main = 207 do 208 args <- getArgs 209 main' args 210 211 212main' :: World m => [String] -> m () 213main' args = 214 main'' elmFormatVersion experimental args 215 216main'' :: World m => String -> Maybe String -> [String] -> m () 217main'' elmFormatVersion_ experimental_ args = 218 do 219 c <- handleParseResult $ Flags.parse elmFormatVersion_ experimental_ args 220 case c of 221 Nothing -> return () 222 Just config -> 223 do 224 let autoYes = Flags._yes config 225 resolvedInputFiles <- Execute.run (Execute.forHuman autoYes) $ resolveFiles (Flags._input config) 226 227 case determineWhatToDoFromConfig config resolvedInputFiles of 228 Left NoInputs -> 229 (handleParseResult $ Flags.showHelpText elmFormatVersion_ experimental_) 230 -- TODO: handleParseResult is exitSuccess, so we never get to exitFailure 231 >> exitFailure 232 233 Left message -> 234 exitWithError message 235 236 Right whatToDo -> do 237 elmVersionChoice <- case Flags._elmVersion config of 238 Just v -> return $ Right v 239 Nothing -> autoDetectElmVersion 240 241 case elmVersionChoice of 242 Left message -> 243 putStr message *> exitFailure 244 245 Right elmVersionChoice' -> do 246 let elmVersionResult = determineVersion elmVersionChoice' (Flags._upgrade config) 247 248 case elmVersionResult of 249 Left message -> 250 exitWithError message 251 252 Right elmVersion -> 253 do 254 let run = case (Flags._validate config) of 255 True -> Execute.run $ Execute.forMachine elmVersion True 256 False -> Execute.run $ Execute.forHuman autoYes 257 result <- run $ doIt elmVersion whatToDo 258 if result 259 then exitSuccess 260 else exitFailure 261 262 263autoDetectElmVersion :: World m => m (Either String ElmVersion) 264autoDetectElmVersion = 265 do 266 hasElmPackageJson <- doesFileExist "elm-package.json" 267 if hasElmPackageJson 268 then 269 do 270 hasElmJson <- doesFileExist "elm.json" 271 if hasElmJson 272 then return $ Right Elm_0_19 273 else return $ Right Elm_0_18 274 else return $ Right Elm_0_19 275 276 277validate :: ElmVersion -> (FilePath, Text.Text) -> Either InfoMessage () 278validate elmVersion (inputFile, inputText) = 279 case Parse.parse elmVersion inputText of 280 Result.Result _ (Result.Ok modu) -> 281 if inputText /= Render.render elmVersion modu then 282 Left $ FileWouldChange inputFile 283 else 284 Right () 285 286 Result.Result _ (Result.Err errs) -> 287 Left $ ParseError inputFile (Text.unpack inputText) errs 288 289 290data FormatResult 291 = NoChange FilePath Text.Text 292 | Changed FilePath Text.Text 293 294 295parseModule :: ElmVersion -> (FilePath, Text.Text) -> Either InfoMessage AST.Module.Module 296parseModule elmVersion (inputFile, inputText) = 297 case Parse.parse elmVersion inputText of 298 Result.Result _ (Result.Ok modu) -> 299 Right modu 300 301 Result.Result _ (Result.Err errs) -> 302 Left $ ParseError inputFile (Text.unpack inputText) errs 303 304 305format :: ElmVersion -> (FilePath, Text.Text) -> Either InfoMessage FormatResult 306format elmVersion (inputFile, inputText) = 307 case parseModule elmVersion (inputFile, inputText) of 308 Right modu -> 309 let 310 outputText = Render.render elmVersion modu 311 in 312 Right $ 313 if inputText == outputText 314 then NoChange inputFile outputText 315 else Changed inputFile outputText 316 317 Left message -> 318 Left message 319 320 321readStdin :: InputConsole f => Free f (FilePath, Text.Text) 322readStdin = 323 (,) "<STDIN>" <$> InputConsole.readStdin 324 325 326readFile :: (FileStore f, InfoFormatter f) => FilePath -> Free f (FilePath, Text.Text) 327readFile filePath = 328 onInfo (ProcessingFile filePath) 329 *> ((,) filePath <$> FileStore.readFile filePath) 330 331 332getOutputText :: FormatResult -> Text.Text 333getOutputText result = 334 case result of 335 NoChange _ text -> text 336 Changed _ text -> text 337 338 339updateFile :: FileWriter f => FormatResult -> Free f () 340updateFile result = 341 case result of 342 NoChange _ _ -> return () 343 Changed outputFile outputText -> FileWriter.overwriteFile outputFile outputText 344 345 346logError :: InfoFormatter f => Either InfoMessage () -> Free f Bool 347logError result = 348 case result of 349 Left message -> 350 onInfo message *> return False 351 352 Right () -> 353 return True 354 355 356logErrorOr :: InfoFormatter f => (a -> Free f ()) -> Either InfoMessage a -> Free f Bool 357logErrorOr fn result = 358 case result of 359 Left message -> 360 onInfo message *> return False 361 362 Right value -> 363 fn value *> return True 364 365 366doIt :: (InputConsole f, OutputConsole f, InfoFormatter f, FileStore f, FileWriter f) => ElmVersion -> WhatToDo -> Free f Bool 367doIt elmVersion whatToDo = 368 case whatToDo of 369 ValidateStdin -> 370 (validate elmVersion <$> readStdin) >>= logError 371 372 ValidateFiles first rest -> 373 all id <$> mapM validateFile (first:rest) 374 where validateFile file = (validate elmVersion <$> ElmFormat.readFile file) >>= logError 375 376 StdinToStdout -> 377 (fmap getOutputText <$> format elmVersion <$> readStdin) >>= logErrorOr OutputConsole.writeStdout 378 379 StdinToFile outputFile -> 380 (fmap getOutputText <$> format elmVersion <$> readStdin) >>= logErrorOr (FileWriter.overwriteFile outputFile) 381 382 FormatToFile inputFile outputFile -> 383 (fmap getOutputText <$> format elmVersion <$> ElmFormat.readFile inputFile) >>= logErrorOr (FileWriter.overwriteFile outputFile) 384 385 FormatInPlace first rest -> 386 do 387 canOverwrite <- approve $ FilesWillBeOverwritten (first:rest) 388 if canOverwrite 389 then all id <$> mapM formatFile (first:rest) 390 else return True 391 where 392 formatFile file = (format elmVersion <$> ElmFormat.readFile file) >>= logErrorOr ElmFormat.updateFile 393 394 StdinToJson -> 395 (fmap (Text.pack . Text.JSON.encode . AST.Json.showModule) <$> parseModule elmVersion <$> readStdin) >>= logErrorOr OutputConsole.writeStdout 396 397 -- TODO: this prints "Processing such-and-such-a-file.elm" which makes the JSON output invalid 398 -- FileToJson inputFile -> 399 -- (fmap (Text.pack . Text.JSON.encode . AST.Json.showJSON) <$> parseModule <$> ElmFormat.readFile inputFile) >>= logErrorOr OutputConsole.writeStdout 400