hindent-6.3.0: src/HIndent/Ast/Name/Prefix.hs

{-# LANGUAGE RecordWildCards #-}

module HIndent.Ast.Name.Prefix
  ( PrefixName
  , mkPrefixName
  , fromString
  , PrefixAsInfix
  , mkPrefixAsInfix
  , prefixAsInfixFixity
  ) where

import Data.Maybe
import qualified GHC.Types.Fixity as Fixity
import qualified GHC.Types.Name as GHC
import qualified GHC.Types.Name.Reader as GHC
import HIndent.Ast.Module.Name
import HIndent.Ast.NodeComments
import HIndent.Fixity (fixities)
import {-# SOURCE #-} HIndent.Pretty
import HIndent.Pretty.Combinators
import HIndent.Pretty.NodeComments

data PrefixName = PrefixName
  { name :: String
  , moduleName :: Maybe ModuleName
  , parentheses :: Bool
  }

instance CommentExtraction PrefixName where
  nodeComments PrefixName {} = NodeComments [] [] []

instance Pretty PrefixName where
  pretty' PrefixName {..} =
    wrap $ hDotSep $ catMaybes [pretty <$> moduleName, Just $ string name]
    where
      wrap =
        if parentheses
          then parens
          else id

mkPrefixName :: GHC.RdrName -> PrefixName
mkPrefixName (GHC.Unqual name) =
  PrefixName (showOutputable name) Nothing (parensNeeded name)
mkPrefixName (GHC.Qual modName name) =
  PrefixName
    (showOutputable name)
    (Just $ mkModuleName modName)
    (parensNeeded name)
mkPrefixName (GHC.Orig {}) =
  error "This AST node should not appear in the parser output."
mkPrefixName (GHC.Exact name) =
  PrefixName (showOutputable name) Nothing (parensNeeded $ GHC.occName name)

fromString :: String -> PrefixName
fromString name = PrefixName name Nothing False

newtype PrefixAsInfix =
  PrefixAsInfix PrefixName

instance CommentExtraction PrefixAsInfix where
  nodeComments (PrefixAsInfix prefix) = nodeComments prefix

instance Pretty PrefixAsInfix where
  pretty' (PrefixAsInfix PrefixName {..}) =
    wrap $ hDotSep $ catMaybes [pretty <$> moduleName, Just $ string name]
    where
      wrap =
        if parentheses
          then id
          else backticks

mkPrefixAsInfix :: PrefixName -> PrefixAsInfix
mkPrefixAsInfix = PrefixAsInfix

prefixAsInfixFixity :: PrefixAsInfix -> Fixity.Fixity
prefixAsInfixFixity (PrefixAsInfix PrefixName {..}) =
  fromMaybe Fixity.defaultFixity $ lookup name fixities

parensNeeded :: GHC.OccName -> Bool
parensNeeded = GHC.isSymOcc