Replace weird whitespace characters by normal spaces

I'm just curios of their origin. If I'm not mistaken they were introduced by
@yumiova.
This commit is contained in:
mrkkrp 2019-08-05 21:01:52 +02:00
parent 09e2a538ef
commit 8870acd41f
No known key found for this signature in database
GPG Key ID: 8564658B2889FF7C
8 changed files with 16 additions and 16 deletions

View File

@ -40,7 +40,7 @@ foo = do
c <- a + b c <- a + b
print c print c
rec something $ do rec something $ do
x <- a x <- a
print x print x

View File

@ -181,7 +181,7 @@ backticks m = do
-- | Surround given entity by banana brackets (i.e., from arrow notation.) -- | Surround given entity by banana brackets (i.e., from arrow notation.)
banana :: R () -> R () banana :: R () -> R ()
banana m = sitcc $ do banana m = sitcc $ do
txt "(|" txt "(|"
ospaces m ospaces m
txt "|)" txt "|)"

View File

@ -41,9 +41,9 @@ p_classDecl ctx name tvars fixity fdeps csigs cdefs cats catdefs = do
dependencySpans = getLoc <$> fdeps dependencySpans = getLoc <$> fdeps
combinedSpans = getLoc ctx : (signatureSpans ++ dependencySpans) combinedSpans = getLoc ctx : (signatureSpans ++ dependencySpans)
txt "class" txt "class"
switchLayout combinedSpans $ do switchLayout combinedSpans $ do
breakpoint breakpoint
inci $ do inci $ do
p_classContext ctx p_classContext ctx
switchLayout signatureSpans $ do switchLayout signatureSpans $ do
p_infixDefHelper p_infixDefHelper
@ -73,7 +73,7 @@ p_classDecl ctx name tvars fixity fdeps csigs cdefs cats catdefs = do
else newline else newline
p_classContext :: LHsContext GhcPs -> R () p_classContext :: LHsContext GhcPs -> R ()
p_classContext ctx = unless (null (unLoc ctx)) $ do p_classContext ctx = unless (null (unLoc ctx)) $ do
located ctx p_hsContext located ctx p_hsContext
breakpoint breakpoint
txt "=> " txt "=> "

View File

@ -30,12 +30,12 @@ p_dataDecl style name tpats fixity HsDataDefn {..} = do
txt $ case dd_ND of txt $ case dd_ND of
NewType -> "newtype" NewType -> "newtype"
DataType -> "data" DataType -> "data"
txt $ case style of txt $ case style of
Associated -> mempty Associated -> mempty
Free -> " instance" Free -> " instance"
switchLayout (getLoc name : fmap getLoc tpats) $ do switchLayout (getLoc name : fmap getLoc tpats) $ do
breakpoint breakpoint
inci $ p_infixDefHelper inci $ p_infixDefHelper
(isInfix fixity) (isInfix fixity)
inci inci
(p_rdrName name) (p_rdrName name)

View File

@ -69,7 +69,7 @@ p_clsInstDecl = \case
case cid_poly_ty of case cid_poly_ty of
HsIB {..} -> located hsib_body $ \x -> do HsIB {..} -> located hsib_body $ \x -> do
breakpoint breakpoint
inci $ do inci $ do
match_overlap_mode cid_overlap_mode breakpoint match_overlap_mode cid_overlap_mode breakpoint
p_hsType x p_hsType x
-- GHC's AST does not necessarily store each kind of element in source -- GHC's AST does not necessarily store each kind of element in source

View File

@ -26,7 +26,7 @@ p_famDecl style FamilyDecl {..} = do
DataFamily -> Nothing <$ txt "data" DataFamily -> Nothing <$ txt "data"
OpenTypeFamily -> Nothing <$ txt "type" OpenTypeFamily -> Nothing <$ txt "type"
ClosedTypeFamily eqs -> Just eqs <$ txt "type" ClosedTypeFamily eqs -> Just eqs <$ txt "type"
txt $ case style of txt $ case style of
Associated -> mempty Associated -> mempty
Free -> " family" Free -> " family"
let HsQTvs {..} = fdTyVars let HsQTvs {..} = fdTyVars

View File

@ -235,7 +235,7 @@ p_grhs' pretty style (GRHS NoExt guards body) =
txt "| " txt "| "
sitcc (sep (comma >> breakpoint) (sitcc . located' p_stmt) xs) sitcc (sep (comma >> breakpoint) (sitcc . located' p_stmt) xs)
space space
txt $ case style of txt $ case style of
EqualSign -> "=" EqualSign -> "="
RightArrow -> "->" RightArrow -> "->"
breakpoint breakpoint
@ -248,14 +248,14 @@ p_hsCmd :: HsCmd GhcPs -> R ()
p_hsCmd = \case p_hsCmd = \case
HsCmdArrApp NoExt body input arrType _ -> do HsCmdArrApp NoExt body input arrType _ -> do
located body p_hsExpr located body p_hsExpr
txt $ case arrType of txt $ case arrType of
HsFirstOrderApp -> " -<" HsFirstOrderApp -> " -<"
HsHigherOrderApp -> " -<<" HsHigherOrderApp -> " -<<"
placeHanging (exprPlacement (unLoc input)) $ placeHanging (exprPlacement (unLoc input)) $
located input p_hsExpr located input p_hsExpr
HsCmdArrForm NoExt form Prefix _ cmds -> banana $ sitcc $ do HsCmdArrForm NoExt form Prefix _ cmds -> banana $ sitcc $ do
located form p_hsExpr located form p_hsExpr
unless (null cmds) $ do unless (null cmds) $ do
breakpoint breakpoint
inci (sequence_ (intersperse breakpoint (located' p_hsCmdTop <$> cmds))) inci (sequence_ (intersperse breakpoint (located' p_hsCmdTop <$> cmds)))
HsCmdArrForm NoExt form Infix _ [left, right] -> do HsCmdArrForm NoExt form Infix _ [left, right] -> do
@ -406,7 +406,7 @@ p_hsRecField
-> R () -> R ()
p_hsRecField = \HsRecField {..} -> do p_hsRecField = \HsRecField {..} -> do
located hsRecFieldLbl atom located hsRecFieldLbl atom
unless hsRecPun $ do unless hsRecPun $ do
txt " = " txt " = "
located hsRecFieldArg p_hsExpr located hsRecFieldArg p_hsExpr
@ -607,7 +607,7 @@ p_hsExpr = \case
HsSpliceE NoExt splice -> p_hsSplice splice HsSpliceE NoExt splice -> p_hsSplice splice
HsProc NoExt p e -> do HsProc NoExt p e -> do
txt "proc" txt "proc"
located p $ \x -> do located p $ \x -> do
breakpoint breakpoint
inci (p_pat x) inci (p_pat x)
breakpoint breakpoint

View File

@ -165,7 +165,7 @@ p_conDeclField (XConDeclField NoExt) = notImplemented "XConDeclField"
tyVarsToTypes :: LHsQTyVars GhcPs -> [LHsType GhcPs] tyVarsToTypes :: LHsQTyVars GhcPs -> [LHsType GhcPs]
tyVarsToTypes = \case tyVarsToTypes = \case
HsQTvs {..} -> fmap tyVarToType <$> hsq_explicit HsQTvs {..} -> fmap tyVarToType <$> hsq_explicit
XLHsQTyVars {} -> notImplemented "XLHsQTyVars" XLHsQTyVars {} -> notImplemented "XLHsQTyVars"
tyVarToType :: HsTyVarBndr GhcPs -> HsType GhcPs tyVarToType :: HsTyVarBndr GhcPs -> HsType GhcPs