futhark fmt: add --check option.

Also fixes a bug in formatting of ModTypeWith that was revealed by
--check.

CHANGELOG.md

@@ -26,6 +26,8 @@ and this project adheres to [Semantic Versioning](http://semver.org/spec/v2.0.0.
 
 * `futhark fmt`: improve formatting of value specs.
 
+* `futhark fmt`: add `--check` option.
+
 ## [0.25.25]
 
 ### Added

docs/man/futhark-fmt.rst

@@ -9,7 +9,7 @@ futhark-fmt
 SYNOPSIS
 ========
 
-futhark fmt [FILES]
+futhark fmt [options...] [FILES]
 
 DESCRIPTION
 ===========
@@ -27,6 +27,10 @@ these, insert a linebreak at an arbitrary location.
 OPTIONS
 =======
 
+--check
+  Check if the given files are correctly formatted, and if not,
+  terminate with an error message and a nonzero exit code.
+
 -h
   Print help text to standard output and exit.
 

src/Futhark/CLI/Fmt.hs

@@ -1,25 +1,48 @@
 -- | @futhark fmt@
 module Futhark.CLI.Fmt (main) where
 
-import Control.Monad (forM_)
+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 (hPutDoc, putDoc)
+import Futhark.Util.Pretty (docText, hPutDoc, putDoc)
 import Language.Futhark
 import Language.Futhark.Parser (SyntaxError (..))
 import System.Exit
 import System.IO
 
+newtype FmtCfg = FmtCfg
+  { cfgCheck :: Bool
+  }
+
+initialFmtCfg :: FmtCfg
+initialFmtCfg = FmtCfg {cfgCheck = False}
+
+fmtOptions :: [FunOptDescr FmtCfg]
+fmtOptions =
+  [ Option
+      ""
+      ["check"]
+      (NoArg $ Right $ \cfg -> cfg {cfgCheck = True})
+      "Check whether file is correctly formatted."
+  ]
+
 -- | Run @futhark fmt@.
 main :: String -> [String] -> IO ()
-main = mainWithOptions () [] "[FILES]" $ \args () ->
+main = mainWithOptions initialFmtCfg fmtOptions "[FILES]" $ \args cfg ->
   case args of
     [] -> Just $ putDoc =<< onInput =<< T.getContents
     files ->
       Just $ forM_ files $ \file -> do
-        doc <- onInput =<< T.readFile file
-        withFile file WriteMode $ \h -> hPutDoc h doc
+        file_s <- T.readFile file
+        doc <- onInput file_s
+        if cfgCheck cfg
+          then unless (docText doc == file_s) $ do
+            T.hPutStrLn stderr $ T.pack file <> ": not formatted correctly."
+            T.hPutStr stderr $ docText doc
+            exitFailure
+          else withFile file WriteMode $ \h -> hPutDoc h doc
   where
     onInput s = do
       case fmtToDoc "<stdin>" s of

src/Futhark/Fmt/Printer.hs

@@ -533,7 +533,7 @@ instance Format UncheckedModTypeExp where
     let (root, withs) = typeWiths mte
      in addComments loc . localLayout loc $
           fmt root
-            </> sep line (map fmtWith (withs ++ [tr]))
+            </> sep line (map fmtWith (reverse $ tr : withs))
     where
       fmtWith (TypeRef v ps td _) =
         "with"

tests_fmt/expected/modules.fut

@@ -9,14 +9,14 @@ module type mt2 = mt1 with a = i32
 
 module type mt3 =
   mt1
-  with b = bool
   with a = i32
+  with b = bool
   with c = f32
 
 module m
   : mt1
-    with b = bool
     with a = i32
+    with b = bool
     with c = f32 = {
   type a = i32
   type b = bool

tests_fmt/test.sh

@@ -5,12 +5,14 @@ diff_error=0
 rm -rf "$test_dir" && mkdir "$test_dir"
 for file in *.fut; do
     fmtFile=$test_dir/$(basename -s .fut $file).fmt.fut
-    futhark fmt < $file > $fmtFile
-    if ! cmp --silent expected/$file $fmtFile; then
-        echo "$file didn't format as expected"
-        diff_error=1
-    else
-        rm $fmtFile
+    if futhark fmt --check expected/$file; then
+        futhark fmt < $file > $fmtFile
+        if ! cmp --silent expected/$file $fmtFile; then
+            echo "$file didn't format as expected"
+            diff_error=1
+        else
+            rm $fmtFile
+        fi
     fi
 done