mirror of
https://github.com/google/ormolu.git
synced 2024-09-11 08:05:24 +03:00
Implement printer for ‘WarningD’
This commit is contained in:
parent
bdc8738fa8
commit
3c506ecf2b
@ -0,0 +1,9 @@
|
||||
{-# WARNING
|
||||
test
|
||||
, foo
|
||||
[ "These are bad functions"
|
||||
, "Really bad!"
|
||||
]
|
||||
#-}
|
||||
test :: IO ()
|
||||
test = pure ()
|
4
data/examples/declaration/warning/warning-multiline.hs
Normal file
4
data/examples/declaration/warning/warning-multiline.hs
Normal file
@ -0,0 +1,4 @@
|
||||
{-# WArNING test,
|
||||
foo ["These are bad functions", "Really bad!"] #-}
|
||||
test :: IO ()
|
||||
test = pure ()
|
@ -0,0 +1,4 @@
|
||||
{-# WARNING test "This is a warning" #-}
|
||||
{-# DEPRECATED test, foo "This is a deprecation" #-}
|
||||
test :: IO ()
|
||||
test = pure ()
|
5
data/examples/declaration/warning/warning-single-line.hs
Normal file
5
data/examples/declaration/warning/warning-single-line.hs
Normal file
@ -0,0 +1,5 @@
|
||||
{-# WARNING test ["This is a warning" ] #-}
|
||||
{-# Deprecated test, foo "This is a deprecation"
|
||||
#-}
|
||||
test :: IO ()
|
||||
test = pure ()
|
@ -72,6 +72,7 @@ library
|
||||
, Ormolu.Printer.Meat.Declaration.Type
|
||||
, Ormolu.Printer.Meat.Declaration.TypeFamily
|
||||
, Ormolu.Printer.Meat.Declaration.Value
|
||||
, Ormolu.Printer.Meat.Declaration.Warning
|
||||
, Ormolu.Printer.Meat.ImportExport
|
||||
, Ormolu.Printer.Meat.Module
|
||||
, Ormolu.Printer.Meat.Type
|
||||
|
@ -27,6 +27,7 @@ import Ormolu.Printer.Meat.Declaration.Splice
|
||||
import Ormolu.Printer.Meat.Declaration.Type
|
||||
import Ormolu.Printer.Meat.Declaration.TypeFamily
|
||||
import Ormolu.Printer.Meat.Declaration.Value
|
||||
import Ormolu.Printer.Meat.Declaration.Warning
|
||||
import Ormolu.Printer.Meat.Type
|
||||
import Ormolu.Utils
|
||||
|
||||
@ -51,7 +52,7 @@ p_hsDecl style = \case
|
||||
DerivD NoExt x -> p_derivDecl x
|
||||
DefD NoExt x -> p_defaultDecl x
|
||||
ForD NoExt x -> p_foreignDecl x
|
||||
WarningD _ _ -> notImplemented "WarningD"
|
||||
WarningD NoExt x -> p_warnDecls x
|
||||
AnnD NoExt x -> p_annDecl x
|
||||
RuleD _ _ -> notImplemented "RuleD"
|
||||
SpliceD NoExt x -> p_spliceDecl x
|
||||
|
57
src/Ormolu/Printer/Meat/Declaration/Warning.hs
Normal file
57
src/Ormolu/Printer/Meat/Declaration/Warning.hs
Normal file
@ -0,0 +1,57 @@
|
||||
{-# LANGUAGE LambdaCase #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
|
||||
module Ormolu.Printer.Meat.Declaration.Warning
|
||||
( p_warnDecls
|
||||
, p_moduleWarning
|
||||
)
|
||||
where
|
||||
|
||||
import BasicTypes
|
||||
import Data.Foldable
|
||||
import qualified Data.List.NonEmpty as NE
|
||||
import Data.Text (Text)
|
||||
import GHC
|
||||
import Ormolu.Printer.Combinators
|
||||
import Ormolu.Printer.Meat.Common
|
||||
import Ormolu.Utils
|
||||
import SrcLoc (combineSrcSpans)
|
||||
|
||||
p_warnDecls :: WarnDecls GhcPs -> R ()
|
||||
p_warnDecls (Warnings NoExt _ warnings) =
|
||||
traverse_ (located' p_warnDecl) warnings
|
||||
p_warnDecls XWarnDecls {} = notImplemented "XWarnDecls"
|
||||
|
||||
p_warnDecl :: WarnDecl GhcPs -> R ()
|
||||
p_warnDecl (Warning NoExt functions warningTxt) =
|
||||
p_topLevelWarning functions warningTxt
|
||||
p_warnDecl XWarnDecl {} = notImplemented "XWarnDecl"
|
||||
|
||||
p_moduleWarning :: WarningTxt -> R ()
|
||||
p_moduleWarning wtxt = do
|
||||
let (pragmaText, lits) = warningText wtxt
|
||||
switchLayout (listSpan lits) $ do
|
||||
breakpoint
|
||||
inci $ pragma pragmaText (p_lits lits)
|
||||
|
||||
p_topLevelWarning :: [Located RdrName] -> WarningTxt -> R ()
|
||||
p_topLevelWarning fnames wtxt = do
|
||||
let (pragmaText, lits) = warningText wtxt
|
||||
switchLayout (combineSrcSpans (listSpan fnames) (listSpan lits)) $ do
|
||||
pragma pragmaText $ do
|
||||
velt (withSep comma p_rdrName fnames)
|
||||
breakpoint
|
||||
p_lits lits
|
||||
|
||||
warningText :: WarningTxt -> (Text, [Located StringLiteral])
|
||||
warningText = \case
|
||||
WarningTxt _ lits -> ("WARNING", lits)
|
||||
DeprecatedTxt _ lits -> ("DEPRECATED", lits)
|
||||
|
||||
listSpan :: [Located a] -> SrcSpan
|
||||
listSpan xs = combineSrcSpans' (getLoc <$> NE.fromList xs)
|
||||
|
||||
p_lits :: [Located StringLiteral] -> R ()
|
||||
p_lits = \case
|
||||
[l] -> atom l
|
||||
ls -> brackets . velt $ withSep comma atom ls
|
@ -1,4 +1,3 @@
|
||||
{-# LANGUAGE LambdaCase #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE RecordWildCards #-}
|
||||
|
||||
@ -9,20 +8,17 @@ module Ormolu.Printer.Meat.Module
|
||||
)
|
||||
where
|
||||
|
||||
import BasicTypes hiding (InlinePragma)
|
||||
import Control.Monad
|
||||
import Data.Maybe (isJust)
|
||||
import Data.Text (Text)
|
||||
import GHC
|
||||
import Ormolu.Imports
|
||||
import Ormolu.Printer.Combinators
|
||||
import Ormolu.Printer.Comments
|
||||
import Ormolu.Printer.Meat.Common
|
||||
import Ormolu.Printer.Meat.Declaration
|
||||
import Ormolu.Printer.Meat.Declaration.Warning
|
||||
import Ormolu.Printer.Meat.ImportExport
|
||||
import Ormolu.Utils
|
||||
import SrcLoc (combineSrcSpans)
|
||||
import qualified Data.List.NonEmpty as NE
|
||||
|
||||
p_hsModule :: ParsedSource -> R ()
|
||||
p_hsModule loc@(L moduleSpan hsModule) = do
|
||||
@ -38,7 +34,7 @@ p_hsModule loc@(L moduleSpan hsModule) = do
|
||||
Nothing -> pure ()
|
||||
Just hsmodName' -> line $ do
|
||||
located hsmodName' p_hsmodName
|
||||
forM_ hsmodDeprecMessage (located' p_warningTxt)
|
||||
forM_ hsmodDeprecMessage (located' p_moduleWarning)
|
||||
case hsmodExports of
|
||||
Nothing -> return ()
|
||||
Just hsmodExports' -> do
|
||||
@ -53,23 +49,3 @@ p_hsModule loc@(L moduleSpan hsModule) = do
|
||||
trailingComments <- hasMoreComments
|
||||
when (trailingComments && isJust hsmodName) newline
|
||||
spitRemainingComments
|
||||
|
||||
-- | Layout the WARNING\/DEPRECATED pragmas in the module head.
|
||||
|
||||
p_warningTxt :: WarningTxt -> R ()
|
||||
p_warningTxt = \case
|
||||
WarningTxt _ lits -> p_pragma "WARNING" lits
|
||||
DeprecatedTxt _ lits -> p_pragma "DEPRECATED" lits
|
||||
where
|
||||
p_pragma :: Text -> [Located StringLiteral] -> R ()
|
||||
p_pragma pragmaText lits = switchLayout (litsSpan lits) $ do
|
||||
breakpoint
|
||||
inci $ pragma pragmaText (p_lits lits)
|
||||
|
||||
litsSpan :: [Located StringLiteral] -> SrcSpan
|
||||
litsSpan lits = combineSrcSpans' (getLoc <$> NE.fromList lits)
|
||||
|
||||
p_lits :: [Located StringLiteral] -> R ()
|
||||
p_lits = \case
|
||||
[l] -> atom l
|
||||
ls -> brackets . velt $ withSep comma atom ls
|
||||
|
Loading…
Reference in New Issue
Block a user