diff options
Diffstat (limited to 'lib')
-rw-r--r-- | lib/Language/Haskell/Stylish/Config.hs | 9 | ||||
-rw-r--r-- | lib/Language/Haskell/Stylish/Step/Data.hs | 66 |
2 files changed, 75 insertions, 0 deletions
diff --git a/lib/Language/Haskell/Stylish/Config.hs b/lib/Language/Haskell/Stylish/Config.hs index 725a465..bd15867 100644 --- a/lib/Language/Haskell/Stylish/Config.hs +++ b/lib/Language/Haskell/Stylish/Config.hs @@ -35,6 +35,7 @@ import qualified System.IO as IO (Newline import qualified Language.Haskell.Stylish.Config.Cabal as Cabal import Language.Haskell.Stylish.Config.Internal import Language.Haskell.Stylish.Step +import qualified Language.Haskell.Stylish.Step.Data as Data import qualified Language.Haskell.Stylish.Step.Imports as Imports import qualified Language.Haskell.Stylish.Step.LanguagePragmas as LanguagePragmas import qualified Language.Haskell.Stylish.Step.SimpleAlign as SimpleAlign @@ -52,6 +53,7 @@ type Extensions = [String] -------------------------------------------------------------------------------- data Config = Config { configSteps :: [Step] + , configIndent :: Int , configColumns :: Maybe Int , configLanguageExtensions :: [String] , configNewline :: IO.Newline @@ -119,6 +121,7 @@ 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) @@ -141,6 +144,7 @@ parseConfig _ = mzero catalog :: Map String (Config -> A.Object -> A.Parser Step) catalog = M.fromList [ ("imports", parseImports) + , ("records", parseRecords) , ("language_pragmas", parseLanguagePragmas) , ("simple_align", parseSimpleAlign) , ("squash", parseSquash) @@ -180,6 +184,11 @@ parseSimpleAlign c o = SimpleAlign.step where withDef f k = fromMaybe (f SimpleAlign.defaultConfig) <$> (o A..:? k) +-------------------------------------------------------------------------------- +parseRecords :: Config -> A.Object -> A.Parser Step +parseRecords c _ = Data.step + <$> pure (configIndent c) + -------------------------------------------------------------------------------- parseSquash :: Config -> A.Object -> A.Parser Step diff --git a/lib/Language/Haskell/Stylish/Step/Data.hs b/lib/Language/Haskell/Stylish/Step/Data.hs new file mode 100644 index 0000000..9acd22b --- /dev/null +++ b/lib/Language/Haskell/Stylish/Step/Data.hs @@ -0,0 +1,66 @@ +module Language.Haskell.Stylish.Step.Data where + +import Data.List (find, intercalate) +import Data.Maybe (maybeToList) +import qualified Language.Haskell.Exts as H +import Language.Haskell.Exts.Comments +import Language.Haskell.Stylish.Block +import Language.Haskell.Stylish.Editor +import Language.Haskell.Stylish.Step +import Language.Haskell.Stylish.Util +import Prelude hiding (init) + +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' :: Int -> Lines -> Module -> Lines +step' indentSize ls (module', allComments) = applyChanges changes ls + where + datas' = datas $ fmap linesFromSrcSpan module' + changes = datas' >>= maybeToList . changeDecl allComments indentSize + +findComment :: LineBlock -> [Comment] -> Maybe Comment +findComment lb = find commentOnLine + where + commentOnLine (Comment _ (H.SrcSpan _ start _ end _) _) = + blockStart lb == start && blockEnd lb == end + +commentsWithin :: LineBlock -> [Comment] -> [Comment] +commentsWithin lb = filter within + where + within (Comment _ (H.SrcSpan _ start _ end _) _) = + start >= blockStart lb && end <= blockEnd lb + +changeDecl :: [Comment] -> Int -> H.Decl LineBlock -> Maybe ChangeLine +changeDecl _ _ (H.DataDecl _ (H.DataType _) Nothing _ [] _) = Nothing +changeDecl allComments indentSize (H.DataDecl block (H.DataType _) Nothing dhead decls derivings) + | null $ commentsWithin block allComments = Just $ change block (const $ concat newLines) + | otherwise = Nothing + where + newLines = fmap constructors zipped ++ [fmap (indented . 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 +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 "}"] + where + n1 = processName "{ " ( extractField $ head fields) + ns = fmap (processName ", " . extractField) (tail fields) + processName prefix (fnames, _type, Nothing) = + indented prefix <> intercalate ", " (fmap H.prettyPrint fnames) <> " :: " <> H.prettyPrint _type + processName prefix (fnames, _type, (Just (Comment _ _ c))) = + indented prefix <> intercalate ", " (fmap H.prettyPrint fnames) <> " :: " <> H.prettyPrint _type <> " --" <> c + extractField (H.FieldDecl lb names _type) = (names, _type, findComment lb allComments) + indented = indent indentSize +processConstructor _ init _ decl = [init <> trimLeft (H.prettyPrint decl)] |