module HIndent.Ast.Declaration.Family.Type.ResultSignature
  ( ResultSignature(..)
  , mkResultSignature
  ) where

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 ResultSignature
  = NoSig
  | Kind (GHC.LHsKind GHC.GhcPs)
  | TypeVariable (WithComments TypeVariable)

instance CommentExtraction ResultSignature where
  nodeComments :: ResultSignature -> NodeComments
nodeComments ResultSignature
NoSig = [LEpaComment] -> [LEpaComment] -> [LEpaComment] -> NodeComments
NodeComments [] [] []
  nodeComments Kind {} = [LEpaComment] -> [LEpaComment] -> [LEpaComment] -> NodeComments
NodeComments [] [] []
  nodeComments TypeVariable {} = [LEpaComment] -> [LEpaComment] -> [LEpaComment] -> NodeComments
NodeComments [] [] []

instance Pretty ResultSignature where
  pretty' :: ResultSignature -> Printer ()
pretty' ResultSignature
NoSig = () -> Printer ()
forall a. a -> Printer a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  pretty' (Kind LHsKind GhcPs
x) = HasCallStack => String -> Printer ()
String -> Printer ()
string String
" :: " Printer () -> Printer () -> Printer ()
forall a b. Printer a -> Printer b -> Printer b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> GenLocated SrcSpanAnnA (HsType GhcPs) -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty LHsKind GhcPs
GenLocated SrcSpanAnnA (HsType GhcPs)
x
  pretty' (TypeVariable WithComments TypeVariable
x) = HasCallStack => String -> Printer ()
String -> Printer ()
string String
" = " Printer () -> Printer () -> Printer ()
forall a b. Printer a -> Printer b -> Printer b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> WithComments TypeVariable -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty WithComments TypeVariable
x

mkResultSignature :: GHC.FamilyResultSig GHC.GhcPs -> ResultSignature
mkResultSignature :: FamilyResultSig GhcPs -> ResultSignature
mkResultSignature (GHC.NoSig XNoSig GhcPs
_) = ResultSignature
NoSig
mkResultSignature (GHC.KindSig XCKindSig GhcPs
_ LHsKind GhcPs
x) = LHsKind GhcPs -> ResultSignature
Kind LHsKind GhcPs
x
mkResultSignature (GHC.TyVarSig XTyVarSig GhcPs
_ LHsTyVarBndr () GhcPs
x) = WithComments TypeVariable -> ResultSignature
TypeVariable WithComments TypeVariable
var
  where
    var :: WithComments TypeVariable
var = HsTyVarBndr () GhcPs -> TypeVariable
forall a. HsTyVarBndr a GhcPs -> TypeVariable
mkTypeVariable (HsTyVarBndr () GhcPs -> TypeVariable)
-> WithComments (HsTyVarBndr () GhcPs) -> WithComments TypeVariable
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> GenLocated SrcSpanAnnA (HsTyVarBndr () GhcPs)
-> WithComments (HsTyVarBndr () GhcPs)
forall l a. CommentExtraction l => GenLocated l a -> WithComments a
fromGenLocated LHsTyVarBndr () GhcPs
GenLocated SrcSpanAnnA (HsTyVarBndr () GhcPs)
x