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

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

    newtype FmtCfg = FmtCfg
      { FmtCfg -> Bool
    cfgCheck :: Bool
      }

    initialFmtCfg :: FmtCfg
    initialFmtCfg :: FmtCfg
    initialFmtCfg = FmtCfg {cfgCheck :: Bool
    cfgCheck = Bool
    False}

    fmtOptions :: [FunOptDescr FmtCfg]
    fmtOptions :: [FunOptDescr FmtCfg]
    fmtOptions =
      [ [Char]
    -> [[Char]]
    -> ArgDescr (Either (IO ()) (FmtCfg -> FmtCfg))
    -> [Char]
    -> FunOptDescr FmtCfg
    forall a. [Char] -> [[Char]] -> ArgDescr a -> [Char] -> OptDescr a
    Option
          [Char]
    ""
          [[Char]
    "check"]
          (Either (IO ()) (FmtCfg -> FmtCfg)
    -> ArgDescr (Either (IO ()) (FmtCfg -> FmtCfg))
    forall a. a -> ArgDescr a
    NoArg (Either (IO ()) (FmtCfg -> FmtCfg)
     -> ArgDescr (Either (IO ()) (FmtCfg -> FmtCfg)))
    -> Either (IO ()) (FmtCfg -> FmtCfg)
    -> ArgDescr (Either (IO ()) (FmtCfg -> FmtCfg))
    forall a b. (a -> b) -> a -> b
    $ (FmtCfg -> FmtCfg) -> Either (IO ()) (FmtCfg -> FmtCfg)
    forall a b. b -> Either a b
    Right ((FmtCfg -> FmtCfg) -> Either (IO ()) (FmtCfg -> FmtCfg))
    -> (FmtCfg -> FmtCfg) -> Either (IO ()) (FmtCfg -> FmtCfg)
    forall a b. (a -> b) -> a -> b
    $ \FmtCfg
    cfg -> FmtCfg
    cfg {cfgCheck = True})
          [Char]
    "Check whether file is correctly formatted."
      ]

    -- | Run @futhark fmt@.
    main :: String -> [String] -> IO ()
    main :: [Char] -> [[Char]] -> IO ()
    main = FmtCfg
    -> [FunOptDescr FmtCfg]
    -> [Char]
    -> ([[Char]] -> FmtCfg -> Maybe (IO ()))
    -> [Char]
    -> [[Char]]
    -> IO ()
    forall cfg.
    cfg
    -> [FunOptDescr cfg]
    -> [Char]
    -> ([[Char]] -> cfg -> Maybe (IO ()))
    -> [Char]
    -> [[Char]]
    -> IO ()
    mainWithOptions FmtCfg
    initialFmtCfg [FunOptDescr FmtCfg]
    fmtOptions [Char]
    "[FILES]" (([[Char]] -> FmtCfg -> Maybe (IO ()))
     -> [Char] -> [[Char]] -> IO ())
    -> ([[Char]] -> FmtCfg -> Maybe (IO ()))
    -> [Char]
    -> [[Char]]
    -> IO ()
    forall a b. (a -> b) -> a -> b
    $ \[[Char]]
    args FmtCfg
    cfg ->
      case [[Char]]
    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
    =<< [Char] -> Text -> IO (Doc AnsiStyle)
    onInput [Char]
    "<stdin>" (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
        [[Char]]
    files ->
          IO () -> Maybe (IO ())
    forall a. a -> Maybe a
    Just (IO () -> Maybe (IO ())) -> IO () -> Maybe (IO ())
    forall a b. (a -> b) -> a -> b
    $ [[Char]] -> ([Char] -> IO ()) -> IO ()
    forall (t :: * -> *) (m :: * -> *) a b.
    (Foldable t, Monad m) =>
    t a -> (a -> m b) -> m ()
    forM_ [[Char]]
    files (([Char] -> IO ()) -> IO ()) -> ([Char] -> IO ()) -> IO ()
    forall a b. (a -> b) -> a -> b
    $ \[Char]
    file -> do
            Text
    file_s <- [Char] -> IO Text
    T.readFile [Char]
    file
            Doc AnsiStyle
    doc <- [Char] -> Text -> IO (Doc AnsiStyle)
    onInput [Char]
    file Text
    file_s
            if FmtCfg -> Bool
    cfgCheck FmtCfg
    cfg
              then Bool -> IO () -> IO ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    unless (Doc AnsiStyle -> Text
    forall a. Doc a -> Text
    docText Doc AnsiStyle
    doc Text -> Text -> Bool
    forall a. Eq a => a -> a -> Bool
    == Text
    file_s) (IO () -> IO ()) -> IO () -> IO ()
    forall a b. (a -> b) -> a -> b
    $ do
                Handle -> Text -> IO ()
    T.hPutStrLn Handle
    stderr (Text -> IO ()) -> Text -> IO ()
    forall a b. (a -> b) -> a -> b
    $ [Char] -> Text
    T.pack [Char]
    file Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    ": not formatted correctly."
                Handle -> Text -> IO ()
    T.hPutStr Handle
    stderr (Text -> IO ()) -> Text -> IO ()
    forall a b. (a -> b) -> a -> b
    $ Doc AnsiStyle -> Text
    forall a. Doc a -> Text
    docText Doc AnsiStyle
    doc
                IO ()
    forall a. IO a
    exitFailure
              else [Char] -> IOMode -> (Handle -> IO ()) -> IO ()
    forall r. [Char] -> IOMode -> (Handle -> IO r) -> IO r
    withFile [Char]
    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 :: [Char] -> Text -> IO (Doc AnsiStyle)
    onInput [Char]
    fname Text
    s = do
          case [Char] -> Text -> Either SyntaxError (Doc AnsiStyle)
    fmtToDoc [Char]
    fname Text
    s of
            Left (SyntaxError Loc
    loc Text
    err) -> do
              Handle -> Text -> IO ()
    T.hPutStrLn 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