<commit_before>{-# LANGUAGE PatternGuards #-}

-- This functionality may be moved into GHC at some point, and then
-- we can use the GHC version (#if GHC version is new enough).

-- Some other functions turned out to be useful for converting
-- instance heads, which aren't TyThings, so just export everything.
module Haddock.Convert
--    ( tyThingToHsSynSig {- :: TyThing -> LHsDecl Name -} )
  where

import HsSyn
import TcType ( tcSplitSigmaTy )
import TypeRep
import Type ( splitKindFunTys )
import Name
import Var
import Class
import TyCon
import DataCon
import BasicTypes
import TysPrim ( alphaTyVars )
import TysWiredIn ( listTyConName )
import Bag ( emptyBag )
import SrcLoc ( Located, noLoc )

-- the main function here! yay!
tyThingToHsSynSig :: TyThing -> LHsDecl Name
-- ids (functions and zero-argument a.k.a. CAFs) get a type signature.
-- Including built-in functions like seq.
-- foreign-imported functions could be represented with ForD
-- instead of SigD if we wanted...
tyThingToHsSynSig (AnId i) = noLoc $
  -- in a future code version we could turn idVarDetails = foreign-call
  -- into a ForD instead of a SigD if we wanted.  Haddock doesn't
  -- need to care.
  SigD (synifyIdSig ImplicitizeForAll i)
-- type-constructors (e.g. Maybe) are complicated, put the definition
-- later in the file (also it's used for class associated-types too.)
tyThingToHsSynSig (ATyCon tc) = noLoc $
  TyClD (synifyTyCon tc)
-- a data-constructor alone just gets rendered as a function:
tyThingToHsSynSig (ADataCon dc) = noLoc $
  SigD (TypeSig (synifyName dc)
       (synifyType ImplicitizeForAll (dataConUserType dc)))
-- classes are just a little tedious
tyThingToHsSynSig (AClass cl) = noLoc $
  TyClD $ ClassDecl
    (synifyCtx (classSCTheta cl))
    (synifyName cl)
    (synifyTyVars (classTyVars cl))
    (map (\ (l,r) -> noLoc
               (map getName l, map getName r) ) $
       snd $ classTvsFds cl)
    (map (\i -> noLoc $ synifyIdSig DeleteTopLevelQuantification i)
         (classMethods cl))
    emptyBag --ignore default method definitions, they don't affect signature
    (map synifyClassAT (classATs cl))
    [] --we don't have any docs at this point

-- class associated-types are a subset of TyCon
-- (mainly only type/data-families)
synifyClassAT :: TyCon -> LTyClDecl Name
synifyClassAT tc = noLoc $ synifyTyCon tc

synifyTyCon :: TyCon -> TyClDecl Name
synifyTyCon tc
  | isFunTyCon tc || isPrimTyCon tc =
    TyData
      -- arbitrary lie, they are neither algebraic data nor newtype:
      DataType
      -- no built-in type has any stupidTheta:
      (noLoc [])
      (synifyName tc)
      -- tyConTyVars doesn't work on fun/prim, but we can make them up:
      (zipWith
         (\fakeTyVar realKind -> noLoc $
             KindedTyVar (getName fakeTyVar) realKind)
         alphaTyVars --a, b, c... which are unfortunately all kind *
         (fst . splitKindFunTys $ tyConKind tc)
      )
      -- assume primitive types aren't members of data/newtype families:
      Nothing
      -- we have their kind accurately:
      (Just (tyConKind tc))
      -- no algebraic constructors:
      []<commit_msg>Clean up tyThingToHsSynSig a little<commit_after>{-# LANGUAGE PatternGuards #-}

-- This functionality may be moved into GHC at some point, and then
-- we can use the GHC version (#if GHC version is new enough).

-- Some other functions turned out to be useful for converting
-- instance heads, which aren't TyThings, so just export everything.
module Haddock.Convert
--    ( tyThingToHsSynSig {- :: TyThing -> LHsDecl Name -} )
  where

import HsSyn
import TcType ( tcSplitSigmaTy )
import TypeRep
import Type ( splitKindFunTys )
import Name
import Var
import Class
import TyCon
import DataCon
import BasicTypes
import TysPrim ( alphaTyVars )
import TysWiredIn ( listTyConName )
import Bag ( emptyBag )
import SrcLoc ( Located, noLoc )

-- the main function here! yay!
tyThingToLHsDecl :: TyThing -> LHsDecl Name
tyThingToLHsDecl t = noLoc $ case t of
  -- ids (functions and zero-argument a.k.a. CAFs) get a type signature.
  -- Including built-in functions like seq.
  -- foreign-imported functions could be represented with ForD
  -- instead of SigD if we wanted...
  --
  -- in a future code version we could turn idVarDetails = foreign-call
  -- into a ForD instead of a SigD if we wanted.  Haddock doesn't
  -- need to care.
  AnId i -> SigD (synifyIdSig ImplicitizeForAll i)
  -- type-constructors (e.g. Maybe) are complicated, put the definition
  -- later in the file (also it's used for class associated-types too.)
  ATyCon tc -> TyClD (synifyTyCon tc)
  -- a data-constructor alone just gets rendered as a function:
  ADataCon dc -> SigD (TypeSig (synifyName dc)
    (synifyType ImplicitizeForAll (dataConUserType dc)))
  -- classes are just a little tedious
  AClass cl ->
    TyClD $ ClassDecl
      (synifyCtx (classSCTheta cl))
      (synifyName cl)
      (synifyTyVars (classTyVars cl))
      (map (\ (l,r) -> noLoc
                 (map getName l, map getName r) ) $
         snd $ classTvsFds cl)
      (map (\i -> noLoc $ synifyIdSig DeleteTopLevelQuantification i)
           (classMethods cl))
      emptyBag --ignore default method definitions, they don't affect signature
      (map synifyClassAT (classATs cl))
      [] --we don't have any docs at this point

-- class associated-types are a subset of TyCon
-- (mainly only type/data-families)
synifyClassAT :: TyCon -> LTyClDecl Name
synifyClassAT tc = noLoc $ synifyTyCon tc

synifyTyCon :: TyCon -> TyClDecl Name
synifyTyCon tc
  | isFunTyCon tc || isPrimTyCon tc =
    TyData
      -- arbitrary lie, they are neither algebraic data nor newtype:
      DataType
      -- no built-in type has any stupidTheta:
      (noLoc [])
      (synifyName tc)
      -- tyConTyVars doesn't work on fun/prim, but we can make them up:
      (zipWith
         (\fakeTyVar realKind -> noLoc $
             KindedTyVar (getName fakeTyVar) realKind)
         alphaTyVars --a, b, c... which are unfortunately all kind *
         (fst . splitKindFunTys $ tyConKind tc)
      )
      -- assume primitive types aren't members of data/newtype families:
      Nothing
      -- we have their kind accurately:
      (Just (tyConKind tc))
      -- no algebraic constructors:
      []
{'fraction_non_alphanumeric': 0.0861244019138756, 'fraction_numerical': 0.0, 'mean_word_length': 2.9169269206745785, 'pattern_counts': {'":': 0, '<': 3, '<?xml version=': 0, '>': 21, 'https://': 0, 'lorem ipsum': 0, 'www.': 0, 'xml': 0}, 'pii_count': 0, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 0, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '1840504', 'n_tokens_mistral': 1976, 'n_tokens_neox': 1947, 'n_words': 736}