diff --git a/CHANGELOG b/CHANGELOG --- a/CHANGELOG +++ b/CHANGELOG @@ -1,5 +1,11 @@ # CHANGELOG +- 0.11.0.0 (2020-02-24) + * Disable record formatting by default + * Allow more customization for record formatting (by Maxim Koltsov) + * Disable formatting of data types without records (by Maxim Koltsov) + * Add `-r` flag to recursively find Haskell files (by Akos Marton) + - 0.10.0.0 (2020-01-26) * Switch to HsYAML library (by vijayphoenix) * Expose `format` from main library (by Łukasz Gołębiewski) diff --git a/README.markdown b/README.markdown --- a/README.markdown +++ b/README.markdown @@ -33,6 +33,7 @@ - Replaces tabs by four spaces (turned off by default) - Replaces some ASCII sequences by their Unicode equivalents (turned off by default) +- Format data constructors and fields in records. Feature requests are welcome! Use the [issue tracker] for that. @@ -101,6 +102,61 @@ Use `stylish-haskell --defaults > .stylish-haskell.yaml` to dump a well-documented default configuration to a file, this way you can get started quickly. + +## Record formatting + +Basically, stylish-haskell supports 4 different styles of records, controlled by `records` +in the config file. + +Here's an example of all four styles: + +```haskell +-- equals: "indent 2", "first_field": "indent 2" +data Foo a + = Foo + { a :: Int + , a2 :: String + -- ^ some haddock + } + | Bar + { b :: a + } + deriving (Eq, Show) + deriving (ToJSON) via Bar Foo + +-- equals: "same_line", "first_field": "indent 2" +data Foo a = Foo + { a :: Int + , a2 :: String + -- ^ some haddock + } + | Bar + { b :: a + } + deriving (Eq, Show) + deriving (ToJSON) via Bar Foo + +-- equals: "same_line", "first_field": "same_line" +data Foo a = Foo { a :: Int + , a2 :: String + -- ^ some haddock + } + | Bar { b :: a + } + deriving (Eq, Show) + deriving (ToJSON) via Bar Foo + +-- equals: "indent 2", first_field: "same_line" +data Foo a + = Foo { a :: Int + , a2 :: String + -- ^ some haddock + } + | Bar { b :: a + } + deriving (Eq, Show) + deriving (ToJSON) via Bar Foo +``` ## VIM integration diff --git a/data/stylish-haskell.yaml b/data/stylish-haskell.yaml --- a/data/stylish-haskell.yaml +++ b/data/stylish-haskell.yaml @@ -15,8 +15,33 @@ # # true. # add_language_pragma: true - # Format record definitions - - records: {} + # Format record definitions. This is disabled by default. + # + # You can control the layout of record fields. The only rules that can't be configured + # are these: + # + # - "|" is always aligned with "=" + # - "," in fields is always aligned with "{" + # - "}" is likewise always aligned with "{" + # + # - records: + # # How to format equals sign between type constructor and data constructor. + # # Possible values: + # # - "same_line" -- leave "=" AND data constructor on the same line as the type constructor. + # # - "indent N" -- insert a new line and N spaces from the beginning of the next line. + # equals: "indent 2" + # + # # How to format first field of each record constructor. + # # Possible values: + # # - "same_line" -- "{" and first field goes on the same line as the data constructor. + # # - "indent N" -- insert a new line and N spaces from the beginning of the data constructor + # first_field: "indent 2" + # + # # How many spaces to insert between the column with "," and the beginning of the comment in the next line. + # field_comment: 2 + # + # # How many spaces to insert before "deriving" clause. Deriving clauses are always on separate lines. + # deriving: 2 # Align the right hand side of some elements. This is quite conservative # and only applies to statements where each element occupies a single @@ -224,9 +249,6 @@ # elements into single spaces. Basically, this undoes the effect of # simple_align but is a bit less conservative. # - squash: {} - -# A common indentation setting. Different steps take this into account. -indent: 4 # A common setting is the number of columns (parts of) code will be wrapped # to. Different steps take this into account. diff --git a/lib/Language/Haskell/Stylish.hs b/lib/Language/Haskell/Stylish.hs --- a/lib/Language/Haskell/Stylish.hs +++ b/lib/Language/Haskell/Stylish.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE LambdaCase #-} -------------------------------------------------------------------------------- module Language.Haskell.Stylish ( -- * Run @@ -10,6 +11,7 @@ , trailingWhitespace , unicodeSyntax -- ** Helpers + , findHaskellFiles , stepName -- * Config , module Language.Haskell.Stylish.Config @@ -25,7 +27,11 @@ -------------------------------------------------------------------------------- import Control.Monad (foldM) - +import System.Directory (doesDirectoryExist, + doesFileExist, + listDirectory) +import System.FilePath (takeExtension, + ()) -------------------------------------------------------------------------------- import Language.Haskell.Stylish.Config @@ -103,3 +109,37 @@ format maybeConfigPath maybeFilePath contents = do conf <- loadConfig (makeVerbose True) (fmap unConfigPath maybeConfigPath) pure $ runSteps (configLanguageExtensions conf) maybeFilePath (configSteps conf) $ lines contents + + +-------------------------------------------------------------------------------- +-- | Searches Haskell source files in any given folder recursively. +findHaskellFiles :: Bool -> [FilePath] -> IO [FilePath] +findHaskellFiles v fs = mapM (findFilesR v) fs >>= return . concat + + +-------------------------------------------------------------------------------- +findFilesR :: Bool -> FilePath -> IO [FilePath] +findFilesR _ [] = return [] +findFilesR v path = do + doesFileExist path >>= \case + True -> return [path] + _ -> doesDirectoryExist path >>= \case + True -> findFilesRecursive path >>= + return . filter (\x -> takeExtension x == ".hs") + False -> do + makeVerbose v ("Input folder does not exists: " <> path) + findFilesR v [] + where + findFilesRecursive :: FilePath -> IO [FilePath] + findFilesRecursive = listDirectoryFiles findFilesRecursive + + listDirectoryFiles :: (FilePath -> IO [FilePath]) + -> FilePath -> IO [FilePath] + listDirectoryFiles go topdir = do + ps <- listDirectory topdir >>= + mapM (\x -> do + let dir = topdir x + doesDirectoryExist dir >>= \case + True -> go dir + False -> return [dir]) + return $ concat ps diff --git a/lib/Language/Haskell/Stylish/Config.hs b/lib/Language/Haskell/Stylish/Config.hs --- a/lib/Language/Haskell/Stylish/Config.hs +++ b/lib/Language/Haskell/Stylish/Config.hs @@ -24,12 +24,14 @@ import Data.Map (Map) import qualified Data.Map as M import Data.Maybe (fromMaybe) +import qualified Data.Text as T import Data.YAML (prettyPosWithSource) import Data.YAML.Aeson (decode1Strict) import System.Directory import System.FilePath (()) import qualified System.IO as IO (Newline (..), nativeNewline) +import Text.Read (readMaybe) -------------------------------------------------------------------------------- @@ -54,7 +56,6 @@ -------------------------------------------------------------------------------- data Config = Config { configSteps :: [Step] - , configIndent :: Int , configColumns :: Maybe Int , configLanguageExtensions :: [String] , configNewline :: IO.Newline @@ -121,7 +122,6 @@ -- First load the config without the actual steps config <- Config <$> pure [] - <*> (o A..:? "indent" A..!= 4) <*> (o A..:! "columns" A..!= Just 80) <*> (o A..:? "language_extensions" A..!= []) <*> (o A..:? "newline" >>= parseEnum newlines IO.nativeNewline) @@ -186,8 +186,25 @@ -------------------------------------------------------------------------------- parseRecords :: Config -> A.Object -> A.Parser Step -parseRecords c _ = Data.step - <$> pure (configIndent c) +parseRecords _ o = Data.step + <$> (Data.Config + <$> (o A..: "equals" >>= parseIndent) + <*> (o A..: "first_field" >>= parseIndent) + <*> (o A..: "field_comment") + <*> (o A..: "deriving")) + + +parseIndent :: A.Value -> A.Parser Data.Indent +parseIndent = A.withText "Indent" $ \t -> + if t == "same_line" + then return Data.SameLine + else + if "indent " `T.isPrefixOf` t + then + case readMaybe (T.unpack $ T.drop 7 t) of + Just n -> return $ Data.Indent n + Nothing -> fail $ "Indent: not a number" <> T.unpack (T.drop 7 t) + else fail $ "can't parse indent setting: " <> T.unpack t -------------------------------------------------------------------------------- diff --git a/lib/Language/Haskell/Stylish/Step/Data.hs b/lib/Language/Haskell/Stylish/Step/Data.hs --- a/lib/Language/Haskell/Stylish/Step/Data.hs +++ b/lib/Language/Haskell/Stylish/Step/Data.hs @@ -1,7 +1,9 @@ +{-# LANGUAGE RecordWildCards #-} + module Language.Haskell.Stylish.Step.Data where import Data.List (find, intercalate) -import Data.Maybe (maybeToList) +import Data.Maybe (fromMaybe, maybeToList) import qualified Language.Haskell.Exts as H import Language.Haskell.Exts.Comments import Language.Haskell.Stylish.Block @@ -10,20 +12,36 @@ import Language.Haskell.Stylish.Util import Prelude hiding (init) +data Indent + = SameLine + | Indent !Int + deriving (Show) + +data Config = Config + { cEquals :: !Indent + -- ^ Indent between type constructor and @=@ sign (measured from column 0) + , cFirstField :: !Indent + -- ^ Indent between data constructor and @{@ line (measured from column with data constructor name) + , cFieldComment :: !Int + -- ^ Indent between column with @{@ and start of field line comment (this line has @cFieldComment = 2@) + , cDeriving :: !Int + -- ^ Indent before @deriving@ lines (measured from column 0) + } deriving (Show) + datas :: H.Module l -> [H.Decl l] datas (H.Module _ _ _ _ decls) = decls datas _ = [] type ChangeLine = Change String -step :: Int -> Step -step indentSize = makeStep "Data" (step' indentSize) +step :: Config -> Step +step cfg = makeStep "Data" (step' cfg) -step' :: Int -> Lines -> Module -> Lines -step' indentSize ls (module', allComments) = applyChanges changes ls +step' :: Config -> Lines -> Module -> Lines +step' cfg ls (module', allComments) = applyChanges changes ls where datas' = datas $ fmap linesFromSrcSpan module' - changes = datas' >>= maybeToList . changeDecl allComments indentSize + changes = datas' >>= maybeToList . changeDecl allComments cfg findCommentOnLine :: LineBlock -> [Comment] -> Maybe Comment findCommentOnLine lb = find commentOnLine @@ -43,32 +61,66 @@ within (Comment _ (H.SrcSpan _ start _ end _) _) = start >= blockStart lb && end <= blockEnd lb -changeDecl :: [Comment] -> Int -> H.Decl LineBlock -> Maybe ChangeLine +changeDecl :: [Comment] -> Config -> H.Decl LineBlock -> Maybe ChangeLine changeDecl _ _ (H.DataDecl _ (H.DataType _) Nothing _ [] _) = Nothing -changeDecl allComments indentSize (H.DataDecl block (H.DataType _) Nothing dhead decls derivings) = - Just $ change block (const $ concat newLines) +changeDecl allComments cfg@Config{..} (H.DataDecl block (H.DataType _) Nothing dhead decls derivings) + | hasRecordFields = Just $ change block (const $ concat newLines) + | otherwise = Nothing where - newLines = fmap constructors zipped ++ [fmap (indented . H.prettyPrint) derivings] + hasRecordFields = any + (\qual -> case qual of + (H.QualConDecl _ _ _ (H.RecDecl {})) -> True + _ -> False) + decls + + typeConstructor = "data " <> H.prettyPrint dhead + + -- In any case set @pipeIndent@ such that @|@ is aligned with @=@. + (firstLine, firstLineInit, pipeIndent) = + case cEquals of + SameLine -> (Nothing, typeConstructor <> " = ", length typeConstructor + 1) + Indent n -> (Just [[typeConstructor]], indent n "= ", n) + + newLines = fromMaybe [] firstLine ++ fmap constructors zipped <> [fmap (indent cDeriving . H.prettyPrint) derivings] zipped = zip decls ([1..] ::[Int]) - constructors (decl, 1) = processConstructor allComments typeConstructor indentSize decl - constructors (decl, _) = processConstructor allComments (indented "| ") indentSize decl - typeConstructor = "data " <> H.prettyPrint dhead <> " = " - indented = indent indentSize + + constructors (decl, 1) = processConstructor allComments firstLineInit cfg decl + constructors (decl, _) = processConstructor allComments (indent pipeIndent "| ") cfg decl changeDecl _ _ _ = Nothing -processConstructor :: [Comment] -> String -> Int -> H.QualConDecl LineBlock -> [String] -processConstructor allComments init indentSize (H.QualConDecl _ _ _ (H.RecDecl _ dname fields)) = do - init <> H.prettyPrint dname : n1 ++ ns ++ [indented "}"] +processConstructor :: [Comment] -> String -> Config -> H.QualConDecl LineBlock -> [String] +processConstructor allComments init Config{..} (H.QualConDecl _ _ _ (H.RecDecl _ dname (f:fs))) = do + fromMaybe [] firstLine <> n1 <> ns <> [indent fieldIndent "}"] where - n1 = processName "{ " ( extractField $ head fields) - ns = tail fields >>= (processName ", " . extractField) + n1 = processName firstLinePrefix (extractField f) + ns = fs >>= processName (indent fieldIndent ", ") . extractField + + -- Set @fieldIndent@ such that @,@ is aligned with @{@. + (firstLine, firstLinePrefix, fieldIndent) = + case cFirstField of + SameLine -> + ( Nothing + , init <> H.prettyPrint dname <> " { " + , length init + length (H.prettyPrint dname) + 1 + ) + Indent n -> + ( Just [init <> H.prettyPrint dname] + , indent (length init + n) "{ " + , length init + n + ) + processName prefix (fnames, _type, lineComment, commentBelowLine) = - [indented prefix <> intercalate ", " (fmap H.prettyPrint fnames) <> " :: " <> H.prettyPrint _type <> addLineComment lineComment] ++ addCommentBelow commentBelowLine + [prefix <> intercalate ", " (fmap H.prettyPrint fnames) <> " :: " <> H.prettyPrint _type <> addLineComment lineComment + ] ++ addCommentBelow commentBelowLine + addLineComment (Just (Comment _ _ c)) = " --" <> c addLineComment Nothing = "" + + -- Field comment indent is measured from the column with @{@, hence adding of @fieldIndent@ here. addCommentBelow Nothing = [] - addCommentBelow (Just (Comment _ _ c)) = [indented "--" <> c] + addCommentBelow (Just (Comment _ _ c)) = [indent (fieldIndent + cFieldComment) "--" <> c] + extractField (H.FieldDecl lb names _type) = (names, _type, findCommentOnLine lb allComments, findCommentBelowLine lb allComments) - indented = indent indentSize + processConstructor _ init _ decl = [init <> trimLeft (H.prettyPrint decl)] diff --git a/src/Main.hs b/src/Main.hs --- a/src/Main.hs +++ b/src/Main.hs @@ -21,13 +21,14 @@ -------------------------------------------------------------------------------- data StylishArgs = StylishArgs - { saVersion :: Bool - , saConfig :: Maybe FilePath - , saVerbose :: Bool - , saDefaults :: Bool - , saInPlace :: Bool - , saNoUtf8 :: Bool - , saFiles :: [FilePath] + { saVersion :: Bool + , saConfig :: Maybe FilePath + , saRecursive :: Bool + , saVerbose :: Bool + , saDefaults :: Bool + , saInPlace :: Bool + , saNoUtf8 :: Bool + , saFiles :: [FilePath] } deriving (Show) @@ -45,6 +46,11 @@ OA.short 'c' <> OA.hidden) <*> OA.switch ( + OA.help "Recursive file search" <> + OA.long "recursive" <> + OA.short 'r' <> + OA.hidden) + <*> OA.switch ( OA.help "Run in verbose mode" <> OA.long "verbose" <> OA.short 'v' <> @@ -99,14 +105,20 @@ else do conf <- loadConfig verbose' (saConfig sa) + filesR <- case (saRecursive sa) of + True -> findHaskellFiles (saVerbose sa) (saFiles sa) + _ -> return $ saFiles sa let steps = configSteps conf forM_ steps $ \s -> verbose' $ "Enabled " ++ stepName s ++ " step" verbose' $ "Extra language extensions: " ++ show (configLanguageExtensions conf) - mapM_ (file sa conf) files' + mapM_ (file sa conf) $ files' filesR where verbose' = makeVerbose (saVerbose sa) - files' = if null (saFiles sa) then [Nothing] else map Just (saFiles sa) + files' x = case (saRecursive sa, null x) of + (True,True) -> [] -- No file to format and recursive enabled. + (_,True) -> [Nothing] -- Involving IO.stdin. + (_,False) -> map Just x -- Process available files. -------------------------------------------------------------------------------- diff --git a/stylish-haskell.cabal b/stylish-haskell.cabal --- a/stylish-haskell.cabal +++ b/stylish-haskell.cabal @@ -1,5 +1,5 @@ Name: stylish-haskell -Version: 0.10.0.0 +Version: 0.11.0.0 Synopsis: Haskell code prettifier Homepage: https://github.com/jaspervdj/stylish-haskell License: BSD3 @@ -64,6 +64,7 @@ mtl >= 2.0 && < 2.3, semigroups >= 0.18 && < 0.20, syb >= 0.3 && < 0.8, + text >= 1.2 && < 1.3, HsYAML-aeson >=0.2.0 && < 0.3, HsYAML >=0.2.0 && < 0.3 @@ -148,6 +149,7 @@ haskell-src-exts >= 1.18 && < 1.24, mtl >= 2.0 && < 2.3, syb >= 0.3 && < 0.8, + text >= 1.2 && < 1.3, HsYAML-aeson >=0.2.0 && < 0.3, HsYAML >=0.2.0 && < 0.3 diff --git a/tests/Language/Haskell/Stylish/Config/Tests.hs b/tests/Language/Haskell/Stylish/Config/Tests.hs --- a/tests/Language/Haskell/Stylish/Config/Tests.hs +++ b/tests/Language/Haskell/Stylish/Config/Tests.hs @@ -148,8 +148,11 @@ , " align: false" , " remove_redundant: true" , " - trailing_whitespace: {}" - , " - records: {}" - , "indent: 2" + , " - records:" + , " equals: \"same_line\"" + , " first_field: \"indent 2\"" + , " field_comment: 2" + , " deriving: 4" , "columns: 110" , "language_extensions:" , " - TemplateHaskell" diff --git a/tests/Language/Haskell/Stylish/Step/Data/Tests.hs b/tests/Language/Haskell/Stylish/Step/Data/Tests.hs --- a/tests/Language/Haskell/Stylish/Step/Data/Tests.hs +++ b/tests/Language/Haskell/Stylish/Step/Data/Tests.hs @@ -30,10 +30,15 @@ , testCase "case 17" case17 , testCase "case 18" case18 , testCase "case 19" case19 + , testCase "case 20 (issue 262)" case20 + , testCase "case 21" case21 + , testCase "case 22" case22 + , testCase "case 23" case23 + , testCase "case 24" case24 ] case00 :: Assertion -case00 = expected @=? testStep (step 2) input +case00 = expected @=? testStep (step sameSameStyle) input where input = unlines [ "module Herp where" @@ -44,7 +49,7 @@ expected = input case01 :: Assertion -case01 = expected @=? testStep (step 2) input +case01 = expected @=? testStep (step indentIndentStyle) input where input = unlines [ "module Herp where" @@ -55,13 +60,14 @@ expected = unlines [ "module Herp where" , "" - , "data Foo = Foo" - , " { a :: Int" - , " }" + , "data Foo" + , " = Foo" + , " { a :: Int" + , " }" ] case02 :: Assertion -case02 = expected @=? testStep (step 2) input +case02 = expected @=? testStep (step indentIndentStyle) input where input = unlines [ "module Herp where" @@ -71,14 +77,15 @@ expected = unlines [ "module Herp where" , "" - , "data Foo = Foo" - , " { a :: Int" - , " , a2 :: String" - , " }" + , "data Foo" + , " = Foo" + , " { a :: Int" + , " , a2 :: String" + , " }" ] case03 :: Assertion -case03 = expected @=? testStep (step 2) input +case03 = expected @=? testStep (step indentIndentStyle) input where input = unlines [ "module Herp where" @@ -88,14 +95,15 @@ expected = unlines [ "module Herp where" , "" - , "data Foo a = Foo" - , " { a :: a" - , " , a2 :: String" - , " }" + , "data Foo a" + , " = Foo" + , " { a :: a" + , " , a2 :: String" + , " }" ] case04 :: Assertion -case04 = expected @=? testStep (step 2) input +case04 = expected @=? testStep (step indentIndentStyle) input where input = unlines [ "module Herp where" @@ -105,17 +113,18 @@ expected = unlines [ "module Herp where" , "" - , "data Foo a = Foo" - , " { a :: a" - , " , a2 :: String" - , " }" + , "data Foo a" + , " = Foo" + , " { a :: a" + , " , a2 :: String" + , " }" , " | Bar" - , " { b :: a" - , " }" + , " { b :: a" + , " }" ] case05 :: Assertion -case05 = expected @=? testStep (step 2) input +case05 = expected @=? testStep (step indentIndentStyle) input where input = unlines [ "module Herp where" @@ -128,14 +137,15 @@ expected = unlines [ "module Herp where" , "" - , "data Foo = Foo" - , " { a :: Int" - , " , a2 :: String" - , " }" + , "data Foo" + , " = Foo" + , " { a :: Int" + , " , a2 :: String" + , " }" ] case06 :: Assertion -case06 = expected @=? testStep (step 2) input +case06 = expected @=? testStep (step sameSameStyle) input where input = unlines [ "module Herp where" @@ -145,7 +155,7 @@ expected = input case07 :: Assertion -case07 = expected @=? testStep (step 2) input +case07 = expected @=? testStep (step sameSameStyle) input where input = unlines [ "module Herp where" @@ -155,7 +165,7 @@ expected = input case08 :: Assertion -case08 = expected @=? testStep (step 2) input +case08 = input @=? testStep (step sameSameStyle) input where input = unlines [ "module Herp where" @@ -163,14 +173,9 @@ , "data Phantom a =" , " Phantom" ] - expected = unlines - [ "module Herp where" - , "" - , "data Phantom a = Phantom" - ] case09 :: Assertion -case09 = expected @=? testStep (step 4) input +case09 = expected @=? testStep (step indentIndentStyle4) input where input = unlines [ "module Herp where" @@ -180,18 +185,19 @@ expected = unlines [ "module Herp where" , "" - , "data Foo a b = Foo" - , " { a :: a" - , " , a2 :: String" - , " }" + , "data Foo a b" + , " = Foo" + , " { a :: a" + , " , a2 :: String" + , " }" , " | Bar" - , " { b :: a" - , " , c :: b" - , " }" + , " { b :: a" + , " , c :: b" + , " }" ] case10 :: Assertion -case10 = expected @=? testStep (step 2) input +case10 = expected @=? testStep (step indentIndentStyle) input where input = unlines [ "module Herp where" @@ -202,15 +208,16 @@ expected = unlines [ "module Herp where" , "" - , "data Foo = Foo" - , " { a :: Int" - , " }" + , "data Foo" + , " = Foo" + , " { a :: Int" + , " }" , " deriving (Eq, Generic)" , " deriving (Show)" ] case11 :: Assertion -case11 = expected @=? testStep (step 2) input +case11 = expected @=? testStep (step indentIndentStyle) input where input = unlines [ "{-# LANGUAGE DerivingStrategies #-}" @@ -223,14 +230,15 @@ [ "{-# LANGUAGE DerivingStrategies #-}" , "module Herp where" , "" - , "data Foo = Foo" - , " { a :: Int" - , " }" + , "data Foo" + , " = Foo" + , " { a :: Int" + , " }" , " deriving stock (Show)" ] case12 :: Assertion -case12 = expected @=? testStep (step 4) input +case12 = expected @=? testStep (step indentIndentStyle4) input where input = unlines [ "module Herp where" @@ -241,15 +249,16 @@ expected = unlines [ "module Herp where" , "" - , "data Point = Point" - , " { pointX, pointY :: Double" - , " , pointName :: String" - , " }" + , "data Point" + , " = Point" + , " { pointX, pointY :: Double" + , " , pointName :: String" + , " }" , " deriving (Show)" ] case13 :: Assertion -case13 = expected @=? testStep (step 2) input +case13 = expected @=? testStep (step indentIndentStyle) input where input = unlines [ "module Herp where" @@ -261,13 +270,14 @@ [ "module Herp where" , "" , "-- this is a comment" - , "data Foo = Foo" - , " { a :: Int" - , " }" + , "data Foo" + , " = Foo" + , " { a :: Int" + , " }" ] case14 :: Assertion -case14 = expected @=? testStep (step 2) input +case14 = expected @=? testStep (step indentIndentStyle) input where input = unlines [ "module Herp where" @@ -281,13 +291,14 @@ , "" , "{- this is" , " a comment -}" - , "data Foo = Foo" - , " { a :: Int" - , " }" + , "data Foo" + , " = Foo" + , " { a :: Int" + , " }" ] case15 :: Assertion -case15 = expected @=? testStep (step 2) input +case15 = expected @=? testStep (step indentIndentStyle) input where input = unlines [ "module Herp where" @@ -300,14 +311,15 @@ expected = unlines [ "module Herp where" , "" - , "data Foo a = Foo" - , " { a :: a -- comment" - , " , a2 :: String" - , " }" + , "data Foo a" + , " = Foo" + , " { a :: a -- comment" + , " , a2 :: String" + , " }" ] case16 :: Assertion -case16 = expected @=? testStep (step 2) input +case16 = expected @=? testStep (step indentIndentStyle) input where input = unlines [ "module Herp where" @@ -319,13 +331,14 @@ expected = unlines [ "module Herp where" , "" - , "data Foo = Foo" - , " { a :: Int -- ^ comment" - , " }" + , "data Foo" + , " = Foo" + , " { a :: Int -- ^ comment" + , " }" ] case17 :: Assertion -case17 = expected @=? testStep (step 2) input +case17 = expected @=? testStep (step indentIndentStyle) input where input = unlines [ "module Herp where" @@ -339,15 +352,16 @@ expected = unlines [ "module Herp where" , "" - , "data Foo a = Foo" - , " { a :: a" - , " -- comment" - , " , a2 :: String" - , " }" + , "data Foo a" + , " = Foo" + , " { a :: a" + , " -- comment" + , " , a2 :: String" + , " }" ] case18 :: Assertion -case18 = expected @=? testStep (step 2) input +case18 = expected @=? testStep (step indentIndentStyle) input where input = unlines [ "module Herp where" @@ -361,15 +375,16 @@ expected = unlines [ "module Herp where" , "" - , "data Foo a = Foo" - , " { a :: a" - , " -- ^ comment" - , " , a2 :: String" - , " }" + , "data Foo a" + , " = Foo" + , " { a :: a" + , " -- ^ comment" + , " , a2 :: String" + , " }" ] case19 :: Assertion -case19 = expected @=? testStep (step 2) input +case19 = expected @=? testStep (step indentIndentStyle) input where input = unlines [ "module Herp where" @@ -383,9 +398,139 @@ expected = unlines [ "module Herp where" , "" - , "data Foo a = Foo" - , " { firstName, lastName :: String" - , " -- ^ names" - , " , age :: Int" - , " }" + , "data Foo a" + , " = Foo" + , " { firstName, lastName :: String" + , " -- ^ names" + , " , age :: Int" + , " }" ] + +-- | Should not break Enums (data without records) formatting +-- +-- See https://github.com/jaspervdj/stylish-haskell/issues/262 +case20 :: Assertion +case20 = input @=? testStep (step indentIndentStyle) input + where + input = unlines + [ "module Herp where" + , "" + , "data Tag = Title | Text deriving (Eq, Show)" + ] + +case21 :: Assertion +case21 = expected @=? testStep (step sameSameStyle) input + where + input = unlines + [ "data Foo a" + , " = Foo { a :: Int," + , " a2 :: String" + , " -- ^ some haddock" + , " }" + , " | Bar { b :: a } deriving (Eq, Show)" + , " deriving (ToJSON)" + ] + + expected = unlines + [ "data Foo a = Foo { a :: Int" + , " , a2 :: String" + , " -- ^ some haddock" + , " }" + , " | Bar { b :: a" + , " }" + , " deriving (Eq, Show)" + , " deriving (ToJSON)" + ] + +case22 :: Assertion +case22 = expected @=? testStep (step sameIndentStyle) input + where + input = unlines + [ "data Foo a" + , " = Foo { a :: Int," + , " a2 :: String" + , " -- ^ some haddock" + , " }" + , " | Bar { b :: a } deriving (Eq, Show)" + , " deriving (ToJSON)" + ] + + expected = unlines + [ "data Foo a = Foo" + , " { a :: Int" + , " , a2 :: String" + , " -- ^ some haddock" + , " }" + , " | Bar" + , " { b :: a" + , " }" + , " deriving (Eq, Show)" + , " deriving (ToJSON)" + ] + +case23 :: Assertion +case23 = expected @=? testStep (step indentSameStyle) input + where + input = unlines + [ "data Foo a" + , " = Foo { a :: Int," + , " a2 :: String" + , " -- ^ some haddock" + , " }" + , " | Bar { b :: a } deriving (Eq, Show)" + , " deriving (ToJSON)" + ] + + expected = unlines + [ "data Foo a" + , " = Foo { a :: Int" + , " , a2 :: String" + , " -- ^ some haddock" + , " }" + , " | Bar { b :: a" + , " }" + , " deriving (Eq, Show)" + , " deriving (ToJSON)" + ] + +case24 :: Assertion +case24 = expected @=? testStep (step indentIndentStyle) input + where + input = unlines + [ "data Foo a" + , " = Foo { a :: Int," + , " a2 :: String" + , " -- ^ some haddock" + , " }" + , " | Bar { b :: a } deriving (Eq, Show)" + , " deriving (ToJSON)" + ] + + expected = unlines + [ "data Foo a" + , " = Foo" + , " { a :: Int" + , " , a2 :: String" + , " -- ^ some haddock" + , " }" + , " | Bar" + , " { b :: a" + , " }" + , " deriving (Eq, Show)" + , " deriving (ToJSON)" + ] + +sameSameStyle :: Config +sameSameStyle = Config SameLine SameLine 2 2 + +sameIndentStyle :: Config +sameIndentStyle = Config SameLine (Indent 2) 2 2 + +indentSameStyle :: Config +indentSameStyle = Config (Indent 2) SameLine 2 2 + +indentIndentStyle :: Config +indentIndentStyle = Config (Indent 2) (Indent 2) 2 2 + +indentIndentStyle4 :: Config +indentIndentStyle4 = Config (Indent 4) (Indent 4) 4 4 diff --git a/tests/Language/Haskell/Stylish/Tests.hs b/tests/Language/Haskell/Stylish/Tests.hs --- a/tests/Language/Haskell/Stylish/Tests.hs +++ b/tests/Language/Haskell/Stylish/Tests.hs @@ -5,6 +5,9 @@ -------------------------------------------------------------------------------- +import Data.List (sort) +import System.Directory (createDirectory) +import System.FilePath (normalise, ()) import Test.Framework (Test, testGroup) import Test.Framework.Providers.HUnit (testCase) import Test.HUnit (Assertion, (@?=)) @@ -17,10 +20,14 @@ -------------------------------------------------------------------------------- tests :: Test -tests = testGroup "Language.Haskell.Stylish.Step.Tabs.Tests" +tests = testGroup "Language.Haskell.Stylish.Tests" [ testCase "case 01" case01 , testCase "case 02" case02 , testCase "case 03" case03 + , testCase "case 04" case04 + , testCase "case 05" case05 + , testCase "case 06" case06 + , testCase "case 07" case07 ] @@ -28,11 +35,8 @@ case01 :: Assertion case01 = (@?= result) =<< format Nothing Nothing input where - input = "module Herp where\n data Foo = Bar | Baz" - result = Right [ "module Herp where" - , "data Foo = Bar" - , " | Baz" - ] + input = "module Herp where\ndata Foo = Bar | Baz { baz :: Int }" + result = Right $ lines input -------------------------------------------------------------------------------- @@ -40,27 +44,101 @@ case02 = withTestDirTree $ do writeFile "test-config.yaml" $ unlines [ "steps:" - , " - records: {}" - , "indent: 2" + , " - records:" + , " equals: \"indent 2\"" + , " first_field: \"indent 2\"" + , " field_comment: 2" + , " deriving: 2" ] actual <- format (Just $ ConfigPath "test-config.yaml") Nothing input actual @?= result where - input = "module Herp where\n data Foo = Bar | Baz" + input = "module Herp where\ndata Foo = Bar | Baz { baz :: Int }" result = Right [ "module Herp where" - , "data Foo = Bar" + , "data Foo" + , " = Bar" , " | Baz" + , " { baz :: Int" + , " }" ] - -------------------------------------------------------------------------------- case03 :: Assertion -case03 = (@?= result) =<< format Nothing (Just fileLocation) input +case03 = withTestDirTree $ do + writeFile "test-config.yaml" $ unlines + [ "steps:" + , " - records:" + , " equals: \"same_line\"" + , " first_field: \"same_line\"" + , " field_comment: 2" + , " deriving: 2" + ] + + actual <- format (Just $ ConfigPath "test-config.yaml") Nothing input + actual @?= result where + input = unlines [ "module Herp where" + , "data Foo" + , " = Bar" + , " | Baz" + , " { baz :: Int" + , " }" + ] + result = Right [ "module Herp where" + , "data Foo = Bar" + , " | Baz { baz :: Int" + , " }" + ] + +-------------------------------------------------------------------------------- +case04 :: Assertion +case04 = (@?= result) =<< format Nothing (Just fileLocation) input + where fileLocation = "directory/File.hs" input = "module Herp" result = Left $ "Language.Haskell.Stylish.Parse.parseModule: could not parse " <> fileLocation <> ": ParseFailed (SrcLoc \".hs\" 2 1) \"Parse error: EOF\"" + + +-------------------------------------------------------------------------------- +-- | When providing current dir including folders and files. +case05 :: Assertion +case05 = withTestDirTree $ do + createDirectory aDir >> writeFile c fileCont + mapM_ (flip writeFile fileCont) fs + result <- findHaskellFiles False input + sort result @?= (sort $ map normalise expected) + where + input = c : fs + fs = ["b.hs", "a.hs"] + c = aDir "c.hs" + aDir = "aDir" + expected = ["a.hs", "b.hs", c] + fileCont = "" + + +-------------------------------------------------------------------------------- +-- | When the input item is not file, do not recurse it. +case06 :: Assertion +case06 = withTestDirTree $ do + mapM_ (flip writeFile "") input + result <- findHaskellFiles False input + result @?= expected + where + input = ["b.hs"] + expected = map normalise input + + +-------------------------------------------------------------------------------- +-- | Empty input should result in empty output. +case07 :: Assertion +case07 = withTestDirTree $ do + mapM_ (flip writeFile "") input + result <- findHaskellFiles False input + result @?= expected + where + input = [] + expected = input