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