RFC 101/166 style

.envrc

@@ -0,0 +1 @@
+use_nix

.gitignore

@@ -9,3 +9,4 @@
 /dist-newstyle
 /.ghc.environment.*
 /result
+/.direnv

flake.nix

@@ -8,7 +8,7 @@
 
   inputs = {
     nixpkgs.url = "github:NixOS/nixpkgs/nixpkgs-unstable";
-    nixpkgs-stable.url = "github:NixOS/nixpkgs/nixos-22.05";
+    nixpkgs-stable.url = "github:NixOS/nixpkgs/nixos-23.05";
 
     flake-utils.url = "github:numtide/flake-utils";
 
@@ -84,6 +84,7 @@
               # nixfmt: expand
               cabal-install
               stylish-haskell
+              shellcheck
             ]);
           });
 

main/Main.hs

@@ -43,20 +43,20 @@ data Nixfmt = Nixfmt
 
 options :: Nixfmt
 options =
-  let defaultWidth = 80
+  let defaultWidth = 100
       addDefaultHint value message =
         message ++ "\n[default: " ++ show value ++ "]"
    in Nixfmt
         { files = [] &= args &= typ "FILES"
         , width =
             defaultWidth &=
             help (addDefaultHint defaultWidth "Maximum width in characters")
-        , check = False &= help "Check whether files are formatted"
+        , check = False &= help "Check whether files are formatted without modifying them"
         , quiet = False &= help "Do not report errors"
         , verify =
             False &=
             help
-              "Check that the output parses and formats the same as the input"
+              "Apply sanity checks on the output after formatting"
         } &=
       summary ("nixfmt v" ++ showVersion version) &=
       help "Format Nix source code"

nixfmt.cabal

@@ -41,11 +41,11 @@ executable nixfmt
   else
     buildable: True
   build-depends:
-      base             >= 4.12.0 && < 4.17
+      base             >= 4.12.0 && < 4.19
     , cmdargs          >= 0.10.20 && < 0.11
     , nixfmt
-    , unix             >= 2.7.2 && < 2.8
-    , text             >= 1.2.3 && < 1.3
+    , unix             >= 2.7.2 && < 2.9
+    , text             >= 1.2.3 && < 2.2
 
     -- for System.IO.Atomic
     , directory        >= 1.3.3 && < 1.4
@@ -86,11 +86,13 @@ library
 
   hs-source-dirs:      src
   build-depends:
-      base             >= 4.12.0 && < 4.17
-    , megaparsec       >= 9.0.1 && < 9.3
+      base             >= 4.12.0 && < 4.19
+    , megaparsec       >= 9.0.1 && < 9.6
+    , mtl
     , parser-combinators >= 1.0.3 && < 1.4
     , scientific       >= 0.3.0 && < 0.4.0
-    , text             >= 1.2.3 && < 1.3
+    , text             >= 1.2.3 && < 2.2
+    , transformers
   default-language:    Haskell2010
   ghc-options:
     -Wall
@@ -113,7 +115,7 @@ executable js-interface
       -Wredundant-constraints
       -Wno-orphans
     build-depends:
-      base             >= 4.12.0 && < 4.17
+      base             >= 4.12.0 && < 4.19
       , ghcjs-base     >= 0.2.0 && < 0.3
       , nixfmt
     hs-source-dirs:    js/

src/Nixfmt.hs

@@ -11,15 +11,18 @@ module Nixfmt
     , formatVerify
     ) where
 
+import Data.Either (fromRight)
 import Data.Bifunctor (bimap, first)
-import Data.Text (Text)
+import Data.Text (Text, unpack)
 import qualified Text.Megaparsec as Megaparsec (parse)
 import Text.Megaparsec.Error (errorBundlePretty)
 
 import Nixfmt.Parser (file)
 import Nixfmt.Predoc (layout)
 import Nixfmt.Pretty ()
-import Nixfmt.Types (ParseErrorBundle)
+import Nixfmt.Types (ParseErrorBundle, Whole(..), Expression, walkSubprograms)
+
+-- import Debug.Trace (traceShow, traceShowId)
 
 type Width = Int
 
@@ -31,17 +34,44 @@ format width filename
     = bimap errorBundlePretty (layout width)
     . Megaparsec.parse file filename
 
+-- Same functionality as `format`, but add sanity checks to guarantee the following properties of the formatter:
+-- - Correctness: The formatted output parses, and the parse tree is identical to the input's
+-- - Idempotency: Formatting the output again will not modify it
+--
+-- If any issues are found, the operation will fail and print an error message. It will contain a diff showcasing
+-- the issue on an automatically minimized example based on the input.
 formatVerify :: Width -> FilePath -> Text -> Either String Text
 formatVerify width path unformatted = do
-    unformattedParsed <- parse unformatted
+    unformattedParsed@(Whole unformattedParsed' _) <- parse unformatted
     let formattedOnce = layout width unformattedParsed
-    formattedOnceParsed <- parse formattedOnce
+    formattedOnceParsed <- flip first (parse formattedOnce) $
+        (\x -> pleaseReport "Fails to parse after formatting.\n" <> x <> "\n\nAfter Formatting:\n" <> unpack formattedOnce)
     let formattedTwice = layout width formattedOnceParsed
     if formattedOnceParsed /= unformattedParsed
-    then pleaseReport "Parses differently after formatting."
+    then Left $
+        let
+            minimized = minimize unformattedParsed' (\e -> parse (layout width e) == Right (Whole e []))
+        in
+        pleaseReport "Parses differently after formatting."
+        <> "\n\nBefore formatting:\n" <> (show minimized)
+        <> "\n\nAfter formatting:\n" <> (show $ fromRight (error "TODO") $ parse (layout width minimized))
     else if formattedOnce /= formattedTwice
-    then pleaseReport "Nixfmt is not idempotent."
+    then Left $
+        let
+            minimized = minimize unformattedParsed'
+                (\e -> layout width e == layout width (fromRight (error "TODO") $ parse $ layout width e))
+        in
+        pleaseReport "Nixfmt is not idempotent."
+        <> "\n\nAfter one formatting:\n" <> unpack (layout width minimized)
+        <> "\n\nAfter two:\n" <> unpack (layout width (fromRight (error "TODO") $ parse $ layout width minimized))
     else Right formattedOnce
     where
         parse = first errorBundlePretty . Megaparsec.parse file path
-        pleaseReport x = Left $ path <> ": " <> x <> " This is a bug in nixfmt. Please report it at https://github.com/serokell/nixfmt"
+        pleaseReport x = path <> ": " <> x <> " This is a bug in nixfmt. Please report it at https://github.com/serokell/nixfmt"
+
+
+minimize :: Expression -> (Expression -> Bool) -> Expression
+minimize expr test =
+    case concatMap (\e -> case test e of { False -> [minimize e test]; True -> [] }) $ walkSubprograms expr of
+         result:_ -> result
+         [] -> expr