{-# LANGUAGE RecordWildCards #-}

module HIndent.Ast.Declaration.TypeSynonym.Lhs
  ( TypeSynonymLhs
  , mkTypeSynonymLhs
  ) where

import qualified GHC.Types.Fixity as GHC
import HIndent.Ast.Name.Infix
import HIndent.Ast.Name.Prefix
import HIndent.Ast.NodeComments
import HIndent.Ast.Type.Variable
import HIndent.Ast.WithComments
import qualified HIndent.GhcLibParserWrapper.GHC.Hs as GHC
import {-# SOURCE #-} HIndent.Pretty
import HIndent.Pretty.Combinators
import HIndent.Pretty.NodeComments

data TypeSynonymLhs
  = Prefix
      { TypeSynonymLhs -> WithComments PrefixName
pName :: WithComments PrefixName -- Using `name` in both `Prefix` and `Infix` causes a type conflict.
      , TypeSynonymLhs -> [WithComments TypeVariable]
typeVariables :: [WithComments TypeVariable]
      }
  | Infix
      { TypeSynonymLhs -> WithComments TypeVariable
left :: WithComments TypeVariable
      , TypeSynonymLhs -> WithComments InfixName
iName :: WithComments InfixName
      , TypeSynonymLhs -> WithComments TypeVariable
right :: WithComments TypeVariable
      }

instance CommentExtraction TypeSynonymLhs where
  nodeComments :: TypeSynonymLhs -> NodeComments
nodeComments Prefix {} = [LEpaComment] -> [LEpaComment] -> [LEpaComment] -> NodeComments
NodeComments [] [] []
  nodeComments Infix {} = [LEpaComment] -> [LEpaComment] -> [LEpaComment] -> NodeComments
NodeComments [] [] []

instance Pretty TypeSynonymLhs where
  pretty' :: TypeSynonymLhs -> Printer ()
pretty' Prefix {[WithComments TypeVariable]
WithComments PrefixName
pName :: TypeSynonymLhs -> WithComments PrefixName
typeVariables :: TypeSynonymLhs -> [WithComments TypeVariable]
pName :: WithComments PrefixName
typeVariables :: [WithComments TypeVariable]
..} = [Printer ()] -> Printer ()
spaced ([Printer ()] -> Printer ()) -> [Printer ()] -> Printer ()
forall a b. (a -> b) -> a -> b
$ WithComments PrefixName -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty WithComments PrefixName
pName Printer () -> [Printer ()] -> [Printer ()]
forall a. a -> [a] -> [a]
: (WithComments TypeVariable -> Printer ())
-> [WithComments TypeVariable] -> [Printer ()]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap WithComments TypeVariable -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty [WithComments TypeVariable]
typeVariables
  pretty' Infix {WithComments TypeVariable
WithComments InfixName
left :: TypeSynonymLhs -> WithComments TypeVariable
iName :: TypeSynonymLhs -> WithComments InfixName
right :: TypeSynonymLhs -> WithComments TypeVariable
left :: WithComments TypeVariable
iName :: WithComments InfixName
right :: WithComments TypeVariable
..} = [Printer ()] -> Printer ()
spaced [WithComments TypeVariable -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty WithComments TypeVariable
left, WithComments InfixName -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty WithComments InfixName
iName, WithComments TypeVariable -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty WithComments TypeVariable
right]

mkTypeSynonymLhs :: GHC.TyClDecl GHC.GhcPs -> TypeSynonymLhs
mkTypeSynonymLhs :: TyClDecl GhcPs -> TypeSynonymLhs
mkTypeSynonymLhs GHC.SynDecl {tcdFixity :: forall pass. TyClDecl pass -> LexicalFixity
tcdFixity = LexicalFixity
GHC.Prefix, XSynDecl GhcPs
LIdP GhcPs
LHsType GhcPs
LHsQTyVars GhcPs
tcdSExt :: XSynDecl GhcPs
tcdLName :: LIdP GhcPs
tcdTyVars :: LHsQTyVars GhcPs
tcdRhs :: LHsType GhcPs
tcdRhs :: forall pass. TyClDecl pass -> LHsType pass
tcdTyVars :: forall pass. TyClDecl pass -> LHsQTyVars pass
tcdLName :: forall pass. TyClDecl pass -> LIdP pass
tcdSExt :: forall pass. TyClDecl pass -> XSynDecl pass
..} = Prefix {[WithComments TypeVariable]
WithComments PrefixName
pName :: WithComments PrefixName
typeVariables :: [WithComments TypeVariable]
pName :: WithComments PrefixName
typeVariables :: [WithComments TypeVariable]
..}
  where
    pName :: WithComments PrefixName
pName = GenLocated SrcSpanAnnN PrefixName -> WithComments PrefixName
forall l a. CommentExtraction l => GenLocated l a -> WithComments a
fromGenLocated (GenLocated SrcSpanAnnN PrefixName -> WithComments PrefixName)
-> GenLocated SrcSpanAnnN PrefixName -> WithComments PrefixName
forall a b. (a -> b) -> a -> b
$ (RdrName -> PrefixName)
-> GenLocated SrcSpanAnnN RdrName
-> GenLocated SrcSpanAnnN PrefixName
forall a b.
(a -> b) -> GenLocated SrcSpanAnnN a -> GenLocated SrcSpanAnnN b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap RdrName -> PrefixName
mkPrefixName LIdP GhcPs
GenLocated SrcSpanAnnN RdrName
tcdLName
    typeVariables :: [WithComments TypeVariable]
typeVariables =
      (HsTyVarBndr (HsBndrVis GhcPs) GhcPs -> TypeVariable)
-> WithComments (HsTyVarBndr (HsBndrVis GhcPs) GhcPs)
-> WithComments TypeVariable
forall a b. (a -> b) -> WithComments a -> WithComments b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap HsTyVarBndr (HsBndrVis GhcPs) GhcPs -> TypeVariable
forall a. HsTyVarBndr a GhcPs -> TypeVariable
mkTypeVariable (WithComments (HsTyVarBndr (HsBndrVis GhcPs) GhcPs)
 -> WithComments TypeVariable)
-> (GenLocated SrcSpanAnnA (HsTyVarBndr (HsBndrVis GhcPs) GhcPs)
    -> WithComments (HsTyVarBndr (HsBndrVis GhcPs) GhcPs))
-> GenLocated SrcSpanAnnA (HsTyVarBndr (HsBndrVis GhcPs) GhcPs)
-> WithComments TypeVariable
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenLocated SrcSpanAnnA (HsTyVarBndr (HsBndrVis GhcPs) GhcPs)
-> WithComments (HsTyVarBndr (HsBndrVis GhcPs) GhcPs)
forall l a. CommentExtraction l => GenLocated l a -> WithComments a
fromGenLocated (GenLocated SrcSpanAnnA (HsTyVarBndr (HsBndrVis GhcPs) GhcPs)
 -> WithComments TypeVariable)
-> [GenLocated SrcSpanAnnA (HsTyVarBndr (HsBndrVis GhcPs) GhcPs)]
-> [WithComments TypeVariable]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> LHsQTyVars GhcPs -> [LHsTyVarBndr (HsBndrVis GhcPs) GhcPs]
forall pass.
LHsQTyVars pass -> [LHsTyVarBndr (HsBndrVis pass) pass]
GHC.hsq_explicit LHsQTyVars GhcPs
tcdTyVars
mkTypeSynonymLhs GHC.SynDecl {tcdFixity :: forall pass. TyClDecl pass -> LexicalFixity
tcdFixity = LexicalFixity
GHC.Infix, XSynDecl GhcPs
LIdP GhcPs
LHsType GhcPs
LHsQTyVars GhcPs
tcdRhs :: forall pass. TyClDecl pass -> LHsType pass
tcdTyVars :: forall pass. TyClDecl pass -> LHsQTyVars pass
tcdLName :: forall pass. TyClDecl pass -> LIdP pass
tcdSExt :: forall pass. TyClDecl pass -> XSynDecl pass
tcdSExt :: XSynDecl GhcPs
tcdLName :: LIdP GhcPs
tcdTyVars :: LHsQTyVars GhcPs
tcdRhs :: LHsType GhcPs
..} =
  case LHsQTyVars GhcPs -> [LHsTyVarBndr (HsBndrVis GhcPs) GhcPs]
forall pass.
LHsQTyVars pass -> [LHsTyVarBndr (HsBndrVis pass) pass]
GHC.hsq_explicit LHsQTyVars GhcPs
tcdTyVars of
    [LHsTyVarBndr (HsBndrVis GhcPs) GhcPs
l, LHsTyVarBndr (HsBndrVis GhcPs) GhcPs
r] -> Infix {WithComments TypeVariable
WithComments InfixName
left :: WithComments TypeVariable
iName :: WithComments InfixName
right :: WithComments TypeVariable
left :: WithComments TypeVariable
iName :: WithComments InfixName
right :: WithComments TypeVariable
..}
      where left :: WithComments TypeVariable
left = HsTyVarBndr (HsBndrVis GhcPs) GhcPs -> TypeVariable
forall a. HsTyVarBndr a GhcPs -> TypeVariable
mkTypeVariable (HsTyVarBndr (HsBndrVis GhcPs) GhcPs -> TypeVariable)
-> WithComments (HsTyVarBndr (HsBndrVis GhcPs) GhcPs)
-> WithComments TypeVariable
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> GenLocated SrcSpanAnnA (HsTyVarBndr (HsBndrVis GhcPs) GhcPs)
-> WithComments (HsTyVarBndr (HsBndrVis GhcPs) GhcPs)
forall l a. CommentExtraction l => GenLocated l a -> WithComments a
fromGenLocated LHsTyVarBndr (HsBndrVis GhcPs) GhcPs
GenLocated SrcSpanAnnA (HsTyVarBndr (HsBndrVis GhcPs) GhcPs)
l
            iName :: WithComments InfixName
iName = GenLocated SrcSpanAnnN InfixName -> WithComments InfixName
forall l a. CommentExtraction l => GenLocated l a -> WithComments a
fromGenLocated (GenLocated SrcSpanAnnN InfixName -> WithComments InfixName)
-> GenLocated SrcSpanAnnN InfixName -> WithComments InfixName
forall a b. (a -> b) -> a -> b
$ (RdrName -> InfixName)
-> GenLocated SrcSpanAnnN RdrName
-> GenLocated SrcSpanAnnN InfixName
forall a b.
(a -> b) -> GenLocated SrcSpanAnnN a -> GenLocated SrcSpanAnnN b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap RdrName -> InfixName
mkInfixName LIdP GhcPs
GenLocated SrcSpanAnnN RdrName
tcdLName
            right :: WithComments TypeVariable
right = HsTyVarBndr (HsBndrVis GhcPs) GhcPs -> TypeVariable
forall a. HsTyVarBndr a GhcPs -> TypeVariable
mkTypeVariable (HsTyVarBndr (HsBndrVis GhcPs) GhcPs -> TypeVariable)
-> WithComments (HsTyVarBndr (HsBndrVis GhcPs) GhcPs)
-> WithComments TypeVariable
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> GenLocated SrcSpanAnnA (HsTyVarBndr (HsBndrVis GhcPs) GhcPs)
-> WithComments (HsTyVarBndr (HsBndrVis GhcPs) GhcPs)
forall l a. CommentExtraction l => GenLocated l a -> WithComments a
fromGenLocated LHsTyVarBndr (HsBndrVis GhcPs) GhcPs
GenLocated SrcSpanAnnA (HsTyVarBndr (HsBndrVis GhcPs) GhcPs)
r
    [LHsTyVarBndr (HsBndrVis GhcPs) GhcPs]
_ -> [Char] -> TypeSynonymLhs
forall a. HasCallStack => [Char] -> a
error [Char]
"Unexpected number of type variables for infix type synonym."
mkTypeSynonymLhs TyClDecl GhcPs
_ = [Char] -> TypeSynonymLhs
forall a. HasCallStack => [Char] -> a
error [Char]
"Not a type synonym."