Pass the test

mihaimaruseac · Oct 22, 2023 · 0506542 · 0506542
1 parent 5e13ded
commit 0506542
Showing 1 changed file with 86 additions and 87 deletions.
diff --git a/src/HIndent.hs b/src/HIndent.hs
@@ -1,6 +1,6 @@
-{-# LANGUAGE CPP #-}
-{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE CPP                 #-}
+{-# LANGUAGE OverloadedStrings   #-}
+{-# LANGUAGE RankNTypes          #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 
 -- | Haskell indenter.
@@ -23,86 +23,85 @@ module HIndent
   , HsModule'
   ) where
 
-import Control.Exception
-import Control.Monad
-import Data.ByteString (ByteString)
-import qualified Data.ByteString as S
-import Data.ByteString.Builder (Builder)
-import qualified Data.ByteString.Builder as S
-import qualified Data.ByteString.Char8 as S8
-import qualified Data.ByteString.Lazy as L
-import qualified Data.ByteString.UTF8 as UTF8
-import Data.Char
-import Data.Maybe
-import Data.Version
-import Foreign.C
-import GHC.IO.Exception
-import GHC.Parser.Lexer hiding (buffer, options)
-import GHC.Types.SrcLoc
-import HIndent.ByteString
-import HIndent.CabalFile
-import HIndent.CodeBlock
-import HIndent.CommandlineOptions
-import HIndent.Config
-import HIndent.Error
-import HIndent.GhcLibParserWrapper.GHC.Hs
-import HIndent.LanguageExtension
+import           Control.Exception
+import           Control.Monad
+import           Data.ByteString                      (ByteString)
+import qualified Data.ByteString                      as S
+import           Data.ByteString.Builder              (Builder)
+import qualified Data.ByteString.Builder              as S
+import qualified Data.ByteString.Char8                as S8
+import qualified Data.ByteString.Lazy                 as L
+import qualified Data.ByteString.UTF8                 as UTF8
+import           Data.Char
+import           Data.Maybe
+import           Data.Version
+import           Foreign.C
+import           GHC.IO.Exception
+import           GHC.Parser.Lexer                     hiding (buffer, options)
+import           GHC.Types.SrcLoc
+import           HIndent.ByteString
+import           HIndent.CabalFile
+import           HIndent.CodeBlock
+import           HIndent.CommandlineOptions
+import           HIndent.Config
+import           HIndent.Error
+import           HIndent.GhcLibParserWrapper.GHC.Hs
+import           HIndent.LanguageExtension
 import qualified HIndent.LanguageExtension.Conversion as CE
-import HIndent.LanguageExtension.Types
-import HIndent.ModulePreprocessing
-import HIndent.Parse
-import HIndent.Pretty
-import HIndent.Printer
-import Options.Applicative hiding (ParseError, action, style)
-import Paths_hindent
-import qualified System.Directory as IO
-import System.Exit
-import qualified System.IO as IO
+import           HIndent.LanguageExtension.Types
+import           HIndent.ModulePreprocessing
+import           HIndent.Parse
+import           HIndent.Pretty
+import           HIndent.Printer
+import           Options.Applicative                  hiding (ParseError,
+                                                       action, style)
+import           Paths_hindent
+import qualified System.Directory                     as IO
+import           System.Exit
+import qualified System.IO                            as IO
 
 -- | Runs HIndent with the given commandline options.
 hindent :: [String] -> IO ()
 hindent args = do
   config <- getConfig
   runMode <-
-    handleParseResult
-      $ execParserPure
-          defaultPrefs
-          (info
-             (options config <**> helper)
-             (header "hindent - Reformat Haskell source code"))
-          args
+    handleParseResult $
+    execParserPure
+      defaultPrefs
+      (info
+         (options config <**> helper)
+         (header "hindent - Reformat Haskell source code"))
+      args
   case runMode of
     ShowVersion -> putStrLn ("hindent " ++ showVersion version)
     Run style exts action paths ->
       if null paths
         then S8.interact
-               (either (error . prettyParseError) id
-                  . reformat style exts Nothing)
+               (either (error . prettyParseError) id .
+                reformat style exts Nothing)
         else forM_ paths $ \filepath -> do
                cabalexts <- getCabalExtensionsForSourcePath filepath
                text <- S.readFile filepath
                case reformat style (cabalexts ++ exts) (Just filepath) text of
                  Left e -> error $ prettyParseError e
                  Right out ->
-                   unless (text == out)
-                     $ case action of
-                         Validate -> do
-                           IO.putStrLn $ filepath ++ " is not formatted"
-                           exitWith (ExitFailure 1)
-                         Reformat -> do
-                           tmpDir <- IO.getTemporaryDirectory
-                           (fp, h) <- IO.openTempFile tmpDir "hindent.hs"
-                           S8.hPutStr h out
-                           IO.hFlush h
-                           IO.hClose h
-                           let exdev e =
-                                 if ioe_errno e
-                                      == Just ((\(Errno a) -> a) eXDEV)
-                                   then IO.copyFile fp filepath
-                                          >> IO.removeFile fp
-                                   else throw e
-                           IO.copyPermissions filepath fp
-                           IO.renameFile fp filepath `catch` exdev
+                   unless (text == out) $
+                   case action of
+                     Validate -> do
+                       IO.putStrLn $ filepath ++ " is not formatted"
+                       exitWith (ExitFailure 1)
+                     Reformat -> do
+                       tmpDir <- IO.getTemporaryDirectory
+                       (fp, h) <- IO.openTempFile tmpDir "hindent.hs"
+                       S8.hPutStr h out
+                       IO.hFlush h
+                       IO.hClose h
+                       let exdev e =
+                             if ioe_errno e == Just ((\(Errno a) -> a) eXDEV)
+                               then IO.copyFile fp filepath >> IO.removeFile fp
+                               else throw e
+                       IO.copyPermissions filepath fp
+                       IO.renameFile fp filepath `catch` exdev
 
 -- | Format the given source.
 reformat ::
@@ -122,22 +121,24 @@ reformat config mexts mfilepath rawCode =
     processBlock (HaskellSource yPos text) =
       let ls = S8.lines text
           prefix = findPrefix ls
-          code = unlines' (map (stripPrefix prefix) ls)
+          code = unlines' (map stripPrefixIfNotNull ls)
+          stripPrefixIfNotNull s =
+            if S.null s
+              then s
+              else stripPrefix prefix s
        in case parseModule mfilepath allExts (UTF8.toString code) of
             POk _ m ->
-              Right
-                $ addPrefix prefix
-                $ L.toStrict
-                $ S.toLazyByteString
-                $ prettyPrint config m
+              Right $
+              addPrefix prefix $
+              L.toStrict $ S.toLazyByteString $ prettyPrint config m
             PFailed st ->
               let rawErrLoc = psRealLoc $ loc st
-               in Left
-                    $ ParseError
-                        { errorLine = srcLocLine rawErrLoc + yPos
-                        , errorCol = srcLocCol rawErrLoc
-                        , errorFile = fromMaybe "<interactive>" mfilepath
-                        }
+               in Left $
+                  ParseError
+                    { errorLine = srcLocLine rawErrLoc + yPos
+                    , errorCol = srcLocCol rawErrLoc
+                    , errorFile = fromMaybe "<interactive>" mfilepath
+                    }
     preserveTrailingNewline f x
       | S8.null x || S8.all isSpace x = return mempty
       | hasTrailingLine x || configTrailingNewline config =
@@ -149,9 +150,9 @@ reformat config mexts mfilepath rawCode =
           (f x)
       | otherwise = f x
     allExts =
-      CE.uniqueExtensions
-        $ concatMap (\x -> x : extensionImplies x)
-        $ mexts ++ configExtensions config ++ allExtsFromCode
+      CE.uniqueExtensions $
+      concatMap (\x -> x : extensionImplies x) $
+      mexts ++ configExtensions config ++ allExtsFromCode
     allExtsFromCode = concatMap f codeBlocks
       where
         f (HaskellSource _ text) =
@@ -165,15 +166,13 @@ testAst x =
   case parseModule Nothing exts (UTF8.toString x) of
     POk _ m -> Right $ modifyASTForPrettyPrinting m
     PFailed st ->
-      Left
-        $ ParseError <$> srcLocLine <*> srcLocCol <*> pure "<interactive>"
-        $ psRealLoc
-        $ loc st
+      Left $
+      ParseError <$> srcLocLine <*> srcLocCol <*> pure "<interactive>" $
+      psRealLoc $ loc st
   where
     exts =
-      CE.uniqueExtensions
-        $ collectLanguageExtensionsFromSource
-        $ UTF8.toString x
+      CE.uniqueExtensions $
+      collectLanguageExtensionsFromSource $ UTF8.toString x
 
 -- | Print the module.
 prettyPrint :: Config -> HsModule' -> Builder