-- | @futhark fmt@
module Futhark.CLI.Fmt (main) where

import Control.Monad (forM_)
import Data.Text.IO qualified as T
import Futhark.Fmt.Printer
import Futhark.Util.Options
import Futhark.Util.Pretty (hPutDoc, putDoc)
import Language.Futhark
import Language.Futhark.Parser (SyntaxError (..))
import System.Exit
import System.IO

-- | Run @futhark fmt@.
main :: String -> [String] -> IO ()
main :: String -> [String] -> IO ()
main = ()
-> [FunOptDescr ()]
-> String
-> ([String] -> () -> Maybe (IO ()))
-> String
-> [String]
-> IO ()
forall cfg.
cfg
-> [FunOptDescr cfg]
-> String
-> ([String] -> cfg -> Maybe (IO ()))
-> String
-> [String]
-> IO ()
mainWithOptions () [] String
"[FILES" (([String] -> () -> Maybe (IO ())) -> String -> [String] -> IO ())
-> ([String] -> () -> Maybe (IO ())) -> String -> [String] -> IO ()
forall a b. (a -> b) -> a -> b
$ \[String]
args () ->
  case [String]
args of
    [] -> IO () -> Maybe (IO ())
forall a. a -> Maybe a
Just (IO () -> Maybe (IO ())) -> IO () -> Maybe (IO ())
forall a b. (a -> b) -> a -> b
$ Doc AnsiStyle -> IO ()
putDoc (Doc AnsiStyle -> IO ()) -> IO (Doc AnsiStyle) -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Text -> IO (Doc AnsiStyle)
onInput (Text -> IO (Doc AnsiStyle)) -> IO Text -> IO (Doc AnsiStyle)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IO Text
T.getContents
    [String]
files ->
      IO () -> Maybe (IO ())
forall a. a -> Maybe a
Just (IO () -> Maybe (IO ())) -> IO () -> Maybe (IO ())
forall a b. (a -> b) -> a -> b
$ [String] -> (String -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [String]
files ((String -> IO ()) -> IO ()) -> (String -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \String
file -> do
        Doc AnsiStyle
doc <- Text -> IO (Doc AnsiStyle)
onInput (Text -> IO (Doc AnsiStyle)) -> IO Text -> IO (Doc AnsiStyle)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< String -> IO Text
T.readFile String
file
        String -> IOMode -> (Handle -> IO ()) -> IO ()
forall r. String -> IOMode -> (Handle -> IO r) -> IO r
withFile String
file IOMode
WriteMode ((Handle -> IO ()) -> IO ()) -> (Handle -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Handle
h -> Handle -> Doc AnsiStyle -> IO ()
hPutDoc Handle
h Doc AnsiStyle
doc
  where
    onInput :: Text -> IO (Doc AnsiStyle)
onInput Text
s = do
      case String -> Text -> Either SyntaxError (Doc AnsiStyle)
fmtToDoc String
"<stdin>" Text
s of
        Left (SyntaxError Loc
loc Text
err) -> do
          Handle -> Text -> IO ()
T.hPutStr Handle
stderr (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ Loc -> Text
forall a. Located a => a -> Text
locText Loc
loc Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
":\n" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
forall a. Pretty a => a -> Text
prettyText Text
err
          IO (Doc AnsiStyle)
forall a. IO a
exitFailure
        Right Doc AnsiStyle
fmt -> Doc AnsiStyle -> IO (Doc AnsiStyle)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Doc AnsiStyle
fmt