{- |
     Author  : Kai-Oliver Prott
     Version : March 2025

     Operations to add information from AbstactCurry to the
     commented declarations.
-}
module CurryDoc.Info.AbstractCurry ( addAbstractCurryProg ) where

import AbstractCurry.Types
import AbstractCurry.Select

import CurryDoc.Data.AnaInfo
import CurryDoc.Data.CurryDoc
import CurryDoc.Info.Comments
import CurryDoc.Info.Goodies

import Data.List  ( last )
import Data.Maybe ( listToMaybe )

-- | Remove unexported entities and
--   add exported entities that did not have any comments.
--   All entities get a lot more information about thei type or ...
--   Also translates into CurryDoc representations and sets a flag for
--   ExternalDataDecls
addAbstractCurryProg :: CurryProg -> [CommentedDecl] -> [CurryDocDecl]
addAbstractCurryProg (CurryProg _ _ _ cls inst typ func _) ds =
  let withins  = addAbstractCurryInstInfo inst ds ++
                 concatMap generateDerivingInstances typ
      withcls  = addAbstractCurryClassesInfo cls ds
      withtyp  = addAbstractCurryDataInfo typ ds withins
      withfun  = addAbstractCurryFunInfo func ds
  in withcls ++ withtyp ++ withfun

-- All addXInfo function are mostly the same:
--   look for the CommentedDecl that matches the AbstractCurry decl
--   When it exists, then add some additional information to the decl
--   Otherwise create one with those infos
-- All this is only done, when the AbstractCurry decl is public (exported)

-- Currently ignores comments and declarations and just adds context and type
addAbstractCurryInstInfo :: [CInstanceDecl] -> [CommentedDecl]
                         -> [CurryDocInstanceDecl]
addAbstractCurryInstInfo []                          _   = []
addAbstractCurryInstInfo (CInstance n cx ts ds : is) cds =
  maybe (CurryDocInstanceDecl n cx ts (addAbstractCurryFunInfo ds []) [])
    (\(CommentedInstanceDecl _ _ cs ds') -> CurryDocInstanceDecl n cx ts
        (addAbstractCurryFunInfo ds ds') cs) (lookupInstance n ts cds)
    : addAbstractCurryInstInfo is cds

-- | Adds superclass and type variable.
addAbstractCurryClassesInfo :: [CClassDecl] -> [CommentedDecl] -> [CurryDocDecl]
addAbstractCurryClassesInfo []                               _   = []
addAbstractCurryClassesInfo (CClass n Public  cx vn fdeps ds:cs) cds =
  maybe (CurryDocClassDecl n cx vn cdfdeps (addAbstractCurryFunInfo ds []) [])
    (\(CommentedClassDecl _ cs' ds') -> CurryDocClassDecl n cx vn cdfdeps
        (addAbstractCurryFunInfo ds ds') cs') (lookupClass n cds)
    : addAbstractCurryClassesInfo cs cds
 where cdfdeps = map CurryDocFunDep fdeps

addAbstractCurryClassesInfo (CClass _ Private _ _ _ _:cs) cds =
  addAbstractCurryClassesInfo cs cds

-- | Adds empty Analysis, qualified type and typesig (if it exists).
addAbstractCurryFunInfo :: [CFuncDecl] -> [CommentedDecl] -> [CurryDocDecl]
addAbstractCurryFunInfo []                             _   = []
addAbstractCurryFunInfo (CFunc n _ Public  qty _ : ds) cds =
  maybe (CurryDocFunctionDecl n qty typesig NoAnalysisInfo [])
    (\(CommentedFunctionDecl _ cs) -> CurryDocFunctionDecl n qty typesig
        NoAnalysisInfo cs)
    (lookupFunc n cds)
    : addAbstractCurryFunInfo ds cds
  where typesig = transformTypesig qty (lookupTypeSig [n] cds)
addAbstractCurryFunInfo (CFunc _ _ Private _   _ : ds) cds =
  addAbstractCurryFunInfo ds cds
addAbstractCurryFunInfo (CmtFunc _ a b c d e : ds) cds =
  addAbstractCurryFunInfo (CFunc a b c d e : ds) cds

-- | Transforms the content of a typesig to CurryDocTypeSig.
transformTypesig :: CQualTypeExpr -> Maybe CommentedDecl
                 -> Maybe CurryDocTypeSig
transformTypesig (CQualType cx _) d = case d of
  Just (CommentedTypeSig [n] cs ps) -> Just (CurryDocTypeSig n cx ps cs)
  _                                 -> Nothing

-- | For data: Adds external info, typevars, instances,
--             and modifies constructors (see below).
--   For new: Adds typevars, instances and modifies constructor.
--   For syn: Adds type and typevars.
addAbstractCurryDataInfo :: [CTypeDecl] -> [CommentedDecl]
                         -> [CurryDocInstanceDecl] -> [CurryDocDecl]
addAbstractCurryDataInfo []                                _   _   = []
addAbstractCurryDataInfo (CTypeSyn n Public vs ty    : ds) cds ins =
  maybe (CurryDocTypeDecl n vs ty [])
    (\(CommentedTypeDecl _ cs) -> CurryDocTypeDecl n vs ty cs)
    (lookupTypeDecl n cds)
    : addAbstractCurryDataInfo ds cds ins
addAbstractCurryDataInfo (CNewType n Public vs con _ : ds) cds ins =
  maybe (CurryDocNewtypeDecl n vs (getInstances n ins)
          (listToMaybe (addAbstractCurryConsInfo [con] [])) [])
    (\(CommentedNewtypeDecl _ cs cn) -> CurryDocNewtypeDecl n vs
        (getInstances n ins)
        (listToMaybe (addAbstractCurryConsInfo [con] [cn])) cs)
    (lookupNewDecl n cds)
    : addAbstractCurryDataInfo ds cds ins
addAbstractCurryDataInfo (CType n Public vs cons _   : ds) cds ins =
  maybe (CurryDocDataDecl n vs (getInstances n ins)
          (null cons) (addAbstractCurryConsInfo cons []) [])
    (\(CommentedDataDecl _ cs cns) -> CurryDocDataDecl n vs (getInstances n ins)
          (null cons) (addAbstractCurryConsInfo cons cns) cs)
    (lookupDataDecl n cds)
    : addAbstractCurryDataInfo ds cds ins
addAbstractCurryDataInfo (CTypeSyn _ Private _ _     : ds) cds ins =
  addAbstractCurryDataInfo ds cds ins
addAbstractCurryDataInfo (CNewType _ Private _ _ _   : ds) cds ins =
  addAbstractCurryDataInfo ds cds ins
addAbstractCurryDataInfo (CType _ Private _ _ _      : ds) cds ins =
  addAbstractCurryDataInfo ds cds ins

-- | Adds type and analysis info and modifies fields for recordss (see below).
addAbstractCurryConsInfo :: [CConsDecl] -> [CommentedConstr] -> [CurryDocCons]
addAbstractCurryConsInfo []                              _   = []
addAbstractCurryConsInfo (CCons   n Public  tys : cs) cds =
  maybe (createConsInfo n tys) (transformConstructor n tys)
    (lookupCons n cds)
    : addAbstractCurryConsInfo cs cds
addAbstractCurryConsInfo (CRecord n Public  fs  : cs) cds =
  maybe (createRecordInfo n fs) (transformRecord n fs)
    (lookupRecord n cds)
    : addAbstractCurryConsInfo cs cds
addAbstractCurryConsInfo (CCons   _ Private _   : cs) cds =
  addAbstractCurryConsInfo cs cds
addAbstractCurryConsInfo (CRecord _ Private _   : cs) cds =
  addAbstractCurryConsInfo cs cds

-- | Creates constructor info.
createConsInfo :: QName -> [CTypeExpr] -> CurryDocCons
createConsInfo n tys
  | isOperator && length tys == 2 =
            let [ty1, ty2] = tys
            in  CurryDocConsOp n ty1 ty2 NoAnalysisInfo []
  | otherwise = CurryDocConstr n tys     NoAnalysisInfo []
  where isOperator = all (`elem` "~!@#$%^&*+-=<>:?./|\\") (snd n)

-- | Creates constructor info for records.
createRecordInfo :: QName -> [CFieldDecl] -> CurryDocCons
createRecordInfo n fs =
  CurryDocRecord n (map cFieldType fs) (addAbstractCurryField fs [])
                 NoAnalysisInfo []

-- | Adds type to constructor.
transformConstructor :: QName -> [CTypeExpr] -> CommentedConstr -> CurryDocCons
transformConstructor n tys c = case c of
  CommentedConstr _ cs
    -> CurryDocConstr n tys                   NoAnalysisInfo cs
  CommentedConsOp _ cs
    -> CurryDocConsOp n (head tys) (last tys) NoAnalysisInfo cs
  _ -> error "CurryDoc.Info.AbstractCurry. transformConstructor"

-- | Adds type to record constructor and modifies fields (see below).
transformRecord :: QName -> [CFieldDecl] -> CommentedConstr -> CurryDocCons
transformRecord n fs c = case c of
  CommentedRecord _ cs fs'
    -> CurryDocRecord n (map cFieldType fs) (addAbstractCurryField fs fs')
                      NoAnalysisInfo cs
  _ -> error "CurryDoc.Info.AbstractCurry. transformRecord"

-- | Adds empty `AnalysisInfo` and type to record fields.
addAbstractCurryField :: [CFieldDecl] -> [CommentedField] -> [CurryDocField]
addAbstractCurryField []                         _   =  []
addAbstractCurryField (CField n Public  ty : fs) cfs =
  maybe (CurryDocField n ty NoAnalysisInfo [])
    (\(_,cs) -> CurryDocField n ty NoAnalysisInfo cs) (lookupField n cfs)
    : addAbstractCurryField fs cfs
addAbstractCurryField (CField _ Private _  : fs) cfs =
  addAbstractCurryField fs cfs

-------------------------------------------------------------------------------
-- Collecting instance informations

-- | Generates all `CurryDocInstanceDecl` for a given type declaration
--   with its deriving clauses.
generateDerivingInstances :: CTypeDecl -> [CurryDocInstanceDecl]
generateDerivingInstances (CType    n Public vs _ der) =
  map (generateDerivingInstanceFor n vs) der
generateDerivingInstances (CNewType n Public vs _ der) =
  map (generateDerivingInstanceFor n vs) der
generateDerivingInstances (CTypeSyn _ _       _ _  ) = []
generateDerivingInstances (CNewType _ Private _ _ _) = []
generateDerivingInstances (CType    _ Private _ _ _) = []

-- | Generates a `CurryDocInstanceDecl` for a given type and deriving clause.
generateDerivingInstanceFor :: QName -> [CTVarIName] -> QName
                            -> CurryDocInstanceDecl
generateDerivingInstanceFor t vs d =
  CurryDocInstanceDecl d (CContext (map (generateConstraintFor d) vs))
    [generateType t vs] [] []

-- | Generates a unary constraint.
generateConstraintFor :: QName -> CTVarIName -> CConstraint
generateConstraintFor n v = (n, [CTVar v])

-- | Generates a type expression for a given type name and type variables.
generateType :: QName -> [CTVarIName] -> CTypeExpr
generateType n = foldl (\t v -> CTApply t (CTVar v)) (CTCons n)

-- | Returns all known instances associated with a given type.
--
-- That is, for a given type name, this function returns all instances
-- that have the given type name in their list of types.
getInstances :: QName -> [CurryDocInstanceDecl] -> [CurryDocInstanceDecl]
getInstances n = filter (any (=~= n) . instTypeNames)