hindent-6.2.0: src/HIndent/Ast/Declaration/Data/Haskell98/Constructor.hs

{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE RecordWildCards #-}

module HIndent.Ast.Declaration.Data.Haskell98.Constructor
  ( Haskell98Constructor
  , mkHaskell98Constructor
  , hasSingleRecordConstructor
  ) where

import HIndent.Applicative
import HIndent.Ast.Context
import HIndent.Ast.Declaration.Data.Haskell98.Constructor.Body
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 Haskell98Constructor = Haskell98Constructor
  { existentialVariables :: [WithComments TypeVariable]
  , context :: Maybe (WithComments Context)
  , body :: Haskell98ConstructorBody
  }

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

instance Pretty Haskell98Constructor where
  pretty' Haskell98Constructor {existentialVariables = [], ..} = do
    whenJust context $ \c -> pretty c >> string " => "
    pretty body
  pretty' Haskell98Constructor {..} = do
    string "forall "
    spaced (fmap pretty existentialVariables)
    string ". " |=> do
      whenJust context $ \c -> pretty c >> string " =>" >> newline
      pretty body

mkHaskell98Constructor :: GHC.ConDecl GHC.GhcPs -> Maybe Haskell98Constructor
mkHaskell98Constructor GHC.ConDeclH98 {..}
  | Just body <- mkHaskell98ConstructorBody GHC.ConDeclH98 {..} =
    Just Haskell98Constructor {..}
  where
    existentialVariables =
      if con_forall
        then fmap (fmap mkTypeVariable . fromGenLocated) con_ex_tvs
        else []
    context = fmap (fmap mkContext . fromGenLocated) con_mb_cxt
mkHaskell98Constructor _ = Nothing

hasSingleRecordConstructor :: Haskell98Constructor -> Bool
hasSingleRecordConstructor = isRecord . body