--------------------------------------------------------------------------------
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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall ann. EpAnn ann -> ann
GHC.anns forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. SrcSpanAnn' a -> a
GHC.ann forall a b. (a -> b) -> a -> b
$ forall l e. GenLocated l e -> l
GHC.getLoc LHsContext 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
_ = 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 forall a b. (a -> b) -> a -> b
$ forall ann. EpAnn ann -> ann
GHC.anns XTypeSig GhcPs
ann
    , GHC.EpaSpan RealSrcSpan
loc Maybe BufSpan
_ <- EpaLocation
epaLoc =
        RealSrcSpan -> String -> Edits
Editor.replaceRealSrcSpan RealSrcSpan
loc String
"∷"
hsSigReplacements Sig GhcPs
_ = forall a. Monoid a => a
mempty


--------------------------------------------------------------------------------
step :: Bool -> String -> Step
step :: Bool -> String -> Step
step = (String -> (Lines -> Module -> Lines) -> Step
makeStep String
"UnicodeSyntax" forall b c a. (b -> c) -> (a -> b) -> a -> c
.) 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 =
        forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap HsType GhcPs -> Edits
hsTyReplacements (forall a b. (Data a, Data b) => a -> [b]
everything Module
modu) forall a. Semigroup a => a -> a -> a
<>
        forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Sig GhcPs -> Edits
hsSigReplacements (forall a b. (Data a, Data b) => a -> [b]
everything Module
modu) forall a. Semigroup a => a -> a -> a
<>
        (if Bool
alp then String -> String -> Module -> Edits
addLanguagePragma String
lg String
"UnicodeSyntax" Module
modu else forall a. Monoid a => a
mempty)