--------------------------------------------------------------------------------
module Language.Haskell.Stylish.Step.UnicodeSyntax
    ( step
    ) where


--------------------------------------------------------------------------------
import qualified GHC.Hs                                        as GHC
import qualified GHC.Types.SrcLoc                              as GHC


--------------------------------------------------------------------------------
import qualified Language.Haskell.Stylish.Editor               as Editor
import           Language.Haskell.Stylish.Module
import           Language.Haskell.Stylish.Step
import           Language.Haskell.Stylish.Step.LanguagePragmas (addLanguagePragma)
import           Language.Haskell.Stylish.Util                 (everything)


--------------------------------------------------------------------------------
hsTyReplacements :: GHC.HsType GHC.GhcPs -> Editor.Edits
hsTyReplacements :: HsType GhcPs -> Edits
hsTyReplacements (GHC.HsFunTy XFunTy GhcPs
_ HsArrow GhcPs
arr LHsType GhcPs
_ LHsType GhcPs
_)
    | GHC.HsUnrestrictedArrow (GHC.L (GHC.TokenLoc EpaLocation
epaLoc) HsUniToken "->" "\8594"
GHC.HsNormalTok) <- HsArrow GhcPs
arr=
        RealSrcSpan -> String -> Edits
Editor.replaceRealSrcSpan (EpaLocation -> RealSrcSpan
GHC.epaLocationRealSrcSpan EpaLocation
epaLoc) String
"→"
hsTyReplacements (GHC.HsQualTy XQualTy GhcPs
_ LHsContext GhcPs
ctx LHsType GhcPs
_)
    | Just (IsUnicodeSyntax, EpaLocation)
arrow <- AnnContext -> Maybe (IsUnicodeSyntax, EpaLocation)
GHC.ac_darrow (AnnContext -> Maybe (IsUnicodeSyntax, EpaLocation))
-> (SrcSpanAnn' (EpAnn AnnContext) -> AnnContext)
-> SrcSpanAnn' (EpAnn AnnContext)
-> Maybe (IsUnicodeSyntax, EpaLocation)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EpAnn AnnContext -> AnnContext
forall ann. EpAnn ann -> ann
GHC.anns (EpAnn AnnContext -> AnnContext)
-> (SrcSpanAnn' (EpAnn AnnContext) -> EpAnn AnnContext)
-> SrcSpanAnn' (EpAnn AnnContext)
-> AnnContext
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SrcSpanAnn' (EpAnn AnnContext) -> EpAnn AnnContext
forall a. SrcSpanAnn' a -> a
GHC.ann (SrcSpanAnn' (EpAnn AnnContext)
 -> Maybe (IsUnicodeSyntax, EpaLocation))
-> SrcSpanAnn' (EpAnn AnnContext)
-> Maybe (IsUnicodeSyntax, EpaLocation)
forall a b. (a -> b) -> a -> b
$ GenLocated
  (SrcSpanAnn' (EpAnn AnnContext))
  [GenLocated SrcSpanAnnA (HsType GhcPs)]
-> SrcSpanAnn' (EpAnn AnnContext)
forall l e. GenLocated l e -> l
GHC.getLoc LHsContext GhcPs
GenLocated
  (SrcSpanAnn' (EpAnn AnnContext))
  [GenLocated SrcSpanAnnA (HsType GhcPs)]
ctx
    , (IsUnicodeSyntax
GHC.NormalSyntax, GHC.EpaSpan RealSrcSpan
loc Maybe BufSpan
_) <- (IsUnicodeSyntax, EpaLocation)
arrow =
        RealSrcSpan -> String -> Edits
Editor.replaceRealSrcSpan RealSrcSpan
loc String
"⇒"
hsTyReplacements HsType GhcPs
_ = Edits
forall a. Monoid a => a
mempty

--------------------------------------------------------------------------------
hsSigReplacements :: GHC.Sig GHC.GhcPs -> Editor.Edits
hsSigReplacements :: Sig GhcPs -> Edits
hsSigReplacements (GHC.TypeSig XTypeSig GhcPs
ann [LIdP GhcPs]
_ LHsSigWcType GhcPs
_)
    | GHC.AddEpAnn AnnKeywordId
GHC.AnnDcolon EpaLocation
epaLoc <- AnnSig -> AddEpAnn
GHC.asDcolon (AnnSig -> AddEpAnn) -> AnnSig -> AddEpAnn
forall a b. (a -> b) -> a -> b
$ EpAnn AnnSig -> AnnSig
forall ann. EpAnn ann -> ann
GHC.anns XTypeSig GhcPs
EpAnn AnnSig
ann
    , GHC.EpaSpan RealSrcSpan
loc Maybe BufSpan
_ <- EpaLocation
epaLoc =
        RealSrcSpan -> String -> Edits
Editor.replaceRealSrcSpan RealSrcSpan
loc String
"∷"
hsSigReplacements Sig GhcPs
_ = Edits
forall a. Monoid a => a
mempty


--------------------------------------------------------------------------------
step :: Bool -> String -> Step
step :: Bool -> String -> Step
step = (String -> (Lines -> Module -> Lines) -> Step
makeStep String
"UnicodeSyntax" ((Lines -> Module -> Lines) -> Step)
-> (String -> Lines -> Module -> Lines) -> String -> Step
forall b c a. (b -> c) -> (a -> b) -> a -> c
.) ((String -> Lines -> Module -> Lines) -> String -> Step)
-> (Bool -> String -> Lines -> Module -> Lines)
-> Bool
-> String
-> Step
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> String -> Lines -> Module -> Lines
step'


--------------------------------------------------------------------------------
step' :: Bool -> String -> Lines -> Module -> Lines
step' :: Bool -> String -> Lines -> Module -> Lines
step' Bool
alp String
lg Lines
ls Module
modu = Edits -> Lines -> Lines
Editor.apply Edits
edits Lines
ls
  where
    edits :: Edits
edits =
        (HsType GhcPs -> Edits) -> [HsType GhcPs] -> Edits
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap HsType GhcPs -> Edits
hsTyReplacements (Module -> [HsType GhcPs]
forall a b. (Data a, Data b) => a -> [b]
everything Module
modu) Edits -> Edits -> Edits
forall a. Semigroup a => a -> a -> a
<>
        (Sig GhcPs -> Edits) -> [Sig GhcPs] -> Edits
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Sig GhcPs -> Edits
hsSigReplacements (Module -> [Sig GhcPs]
forall a b. (Data a, Data b) => a -> [b]
everything Module
modu) Edits -> Edits -> Edits
forall a. Semigroup a => a -> a -> a
<>
        (if Bool
alp then String -> String -> Module -> Edits
addLanguagePragma String
lg String
"UnicodeSyntax" Module
modu else Edits
forall a. Monoid a => a
mempty)