diff options
author | Maxim Koltsov <kolmax94@gmail.com> | 2020-02-17 19:32:01 +0100 |
---|---|---|
committer | GitHub <noreply@github.com> | 2020-02-17 19:32:01 +0100 |
commit | b8a731eb948b98019b8663c6fc653d2c930df2b1 (patch) | |
tree | ac2b95867755910564075caac605636e9babcaf7 /lib | |
parent | ab85690eb35dec46c8eb80a930337249f34b9f80 (diff) | |
download | stylish-haskell-b8a731eb948b98019b8663c6fc653d2c930df2b1.tar.gz |
Introduce nicer style for records (#266)
Diffstat (limited to 'lib')
-rw-r--r-- | lib/Language/Haskell/Stylish/Config.hs | 25 | ||||
-rw-r--r-- | lib/Language/Haskell/Stylish/Step/Data.hs | 88 |
2 files changed, 88 insertions, 25 deletions
diff --git a/lib/Language/Haskell/Stylish/Config.hs b/lib/Language/Haskell/Stylish/Config.hs index ba9cb31..475a5e3 100644 --- a/lib/Language/Haskell/Stylish/Config.hs +++ b/lib/Language/Haskell/Stylish/Config.hs @@ -24,12 +24,14 @@ import Data.List (intercalate, 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 @@ type Extensions = [String] -------------------------------------------------------------------------------- data Config = Config { configSteps :: [Step] - , configIndent :: Int , configColumns :: Maybe Int , configLanguageExtensions :: [String] , configNewline :: IO.Newline @@ -121,7 +122,6 @@ parseConfig (A.Object o) = do -- 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 @@ parseSimpleAlign c o = SimpleAlign.step -------------------------------------------------------------------------------- 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 index 681c7c8..1f7732b 100644 --- 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.Step 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,9 +61,9 @@ commentsWithin lb = filter within 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) +changeDecl allComments cfg@Config{..} (H.DataDecl block (H.DataType _) Nothing dhead decls derivings) | hasRecordFields = Just $ change block (const $ concat newLines) | otherwise = Nothing where @@ -54,27 +72,55 @@ changeDecl allComments indentSize (H.DataDecl block (H.DataType _) Nothing dhead (H.QualConDecl _ _ _ (H.RecDecl {})) -> True _ -> False) decls - newLines = fmap constructors zipped ++ [fmap (indented . H.prettyPrint) derivings] + + 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)] |