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

     Operations to add analysis information
     to the CurryDoc declarations.
-}
module CurryDoc.Info.Analysis
  ( addAnaInfoToCurryDocDecls, addShortAnaInfoToCurryDocDecls ) where

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

import AbstractCurry.Types
import AbstractCurry.Select

import Data.List ( find, partition, isPrefixOf )

-- | Adds analysis information to suitable `CurryDocDecls`.
addAnaInfoToCurryDocDecls :: AnaInfo -> [COpDecl] -> [CFuncDecl]
                          -> [CurryDocDecl] -> [CurryDocDecl]
addAnaInfoToCurryDocDecls ai cop funs =
  map (addAnaInfoToCurryDocDecl ai cop funs)

-- | Adds short analysis information to suitable `CurryDocDecls`.
addShortAnaInfoToCurryDocDecls :: [COpDecl] -> [CFuncDecl]
                               -> [CurryDocDecl] -> [CurryDocDecl]
addShortAnaInfoToCurryDocDecls cop funs =
  map (addShortAnaInfoToCurryDocDecl cop funs)

-- | Recursively descends the declarations and fills in any `AnalysisInfo`.

addAnaInfoToCurryDocDecl :: AnaInfo -> [COpDecl] -> [CFuncDecl] -> CurryDocDecl
                        -> CurryDocDecl
addAnaInfoToCurryDocDecl _  _   _ d@(CurryDocTypeDecl          _ _ _ _) = d
addAnaInfoToCurryDocDecl _  cop _ (CurryDocClassDecl         a b c d e f) =
  CurryDocClassDecl a b c d (map (addPrecedenceInfoToCurryDocDecl cop) e) f
addAnaInfoToCurryDocDecl ai cop funs (CurryDocFunctionDecl n qty sig _ cs) =
  CurryDocFunctionDecl n qty sig (createAnalysisInfoFun ai cop funs n) cs
addAnaInfoToCurryDocDecl _  cop _ (CurryDocDataDecl  idt vs ins ex cns cs) =
  CurryDocDataDecl idt vs ins ex
                   (map (addPrecedenceInfoToCurryDocCons cop) cns) cs
addAnaInfoToCurryDocDecl _  cop _ (CurryDocNewtypeDecl idt vs ins cns cs) =
  CurryDocNewtypeDecl idt vs ins
                      (fmapMaybe (addPrecedenceInfoToCurryDocCons cop) cns) cs
  where fmapMaybe _ Nothing  = Nothing
        fmapMaybe f (Just x) = Just  (f x)

addShortAnaInfoToCurryDocDecl :: [COpDecl] -> [CFuncDecl] -> CurryDocDecl
                              -> CurryDocDecl
addShortAnaInfoToCurryDocDecl _   _ d@(CurryDocTypeDecl          _ _ _ _) = d
addShortAnaInfoToCurryDocDecl cop _ (CurryDocClassDecl         a b c d e f) =
  CurryDocClassDecl a b c d (map (addPrecedenceInfoToCurryDocDecl cop) e) f
addShortAnaInfoToCurryDocDecl cop funs (CurryDocFunctionDecl n qty sig _ cs) =
  CurryDocFunctionDecl n qty sig (createShortAnalysisInfoFun cop funs n) cs
addShortAnaInfoToCurryDocDecl cop _ (CurryDocDataDecl  idt vs ins ex cns cs) =
  CurryDocDataDecl idt vs ins ex
                   (map (addPrecedenceInfoToCurryDocCons cop) cns) cs
addShortAnaInfoToCurryDocDecl cop _ (CurryDocNewtypeDecl idt vs ins cns cs) =
  CurryDocNewtypeDecl idt vs ins
                      (fmapMaybe (addPrecedenceInfoToCurryDocCons cop) cns) cs
  where fmapMaybe _ Nothing  = Nothing
        fmapMaybe f (Just x) = Just  (f x)

addPrecedenceInfoToCurryDocCons :: [COpDecl] -> CurryDocCons -> CurryDocCons
addPrecedenceInfoToCurryDocCons cop (CurryDocConstr c tys     _ cs) =
  CurryDocConstr c tys     (createPrecInfo cop c) cs
addPrecedenceInfoToCurryDocCons cop (CurryDocConsOp c ty1 ty2 _ cs) =
  CurryDocConsOp c ty1 ty2 (createPrecInfo cop c) cs
addPrecedenceInfoToCurryDocCons cop (CurryDocRecord c tys fs  _ cs) =
  CurryDocRecord c tys fs' (createPrecInfo cop c) cs
  where fs' = map (addPrecedenceInfoToField cop) fs

addPrecedenceInfoToField :: [COpDecl] -> CurryDocField -> CurryDocField
addPrecedenceInfoToField cop (CurryDocField n ty _ cs) =
  CurryDocField n ty (createPrecInfo cop n) cs

addPrecedenceInfoToCurryDocDecl :: [COpDecl] -> CurryDocDecl -> CurryDocDecl
addPrecedenceInfoToCurryDocDecl cop d = case d of
  CurryDocFunctionDecl n qty sig _ cs ->
    CurryDocFunctionDecl n qty sig (createPrecInfo cop n) cs
  _                                   -> d

-- | Full analysis for functions.
createAnalysisInfoFun :: AnaInfo -> [COpDecl] -> [CFuncDecl] -> QName
                      -> AnalysisInfo
createAnalysisInfoFun ai cop funs n = AnalysisInfo
    (getNondetInfo ai n)
    (getIndetInfo ai n)
    (getOpCompleteInfo ai n)
    (getExternalInfo funs n)
    (getCompleteInfo ai n)
    (genPrecedenceInfo cop n)
    (genPropertyInfo funs n)

-- | Short analysis for functions.
createShortAnalysisInfoFun :: [COpDecl] -> [CFuncDecl] -> QName -> AnalysisInfo
createShortAnalysisInfoFun cop funs n = ShortAnalysisInfo
    (getExternalInfo funs n)
    (genPrecedenceInfo cop n)
    (genPropertyInfo funs n)

-- | Gets external status of a function by checking the number of rules.
getExternalInfo :: [CFuncDecl] -> QName -> Bool
getExternalInfo []                             _
  = error "CurryDoc.Comment.getExternalInfo: Function not found!"
getExternalInfo (CFunc     n _ _ _ []    : fs) n'
  | n =~= n'  = True
  | otherwise = getExternalInfo fs n'
getExternalInfo (CmtFunc _ n _ _ _ []    : fs) n'
  | n =~= n'  = True
  | otherwise = getExternalInfo fs n'
getExternalInfo (CFunc     n _ _ _ (_:_) : fs) n'
  | n =~= n'  = False
  | otherwise = getExternalInfo fs n'
getExternalInfo (CmtFunc _ n _ _ _ (_:_) : fs) n'
  | n =~= n'  = False
  | otherwise = getExternalInfo fs n'

-- | Only creates a precedence info (e.g. for fields and constructors).
createPrecInfo :: [COpDecl] -> QName -> AnalysisInfo
createPrecInfo cop n = PrecedenceInfo (genPrecedenceInfo cop n)

-- | Looks up the precedence for a given name.
genPrecedenceInfo :: [COpDecl] -> QName -> Maybe (CFixity, Int)
genPrecedenceInfo []                     _ = Nothing
genPrecedenceInfo (COp m fix prec : cop) n
  | n =~= m   = Just (fix, prec)
  | otherwise = genPrecedenceInfo cop n

-- | Checks for properties of a function.
--   (Code from Michael Hanus, modified by Kai Prott)
genPropertyInfo :: [CFuncDecl] -> QName -> [(Property, (QName, CRule))]
genPropertyInfo funs n = getContracts ++ concatMap getProp props
  where
    fprops = takeWhile isPropSpecFun $
             tail $ dropWhile (not . (=~=n) . funcName) funs
    (specs, props) = partition isSpecFun fprops

    getContracts = getContract (snd n ++ "'pre")  PreSpec
                ++ getContract (snd n ++ "'post") PostSpec
                ++ getContract (snd n ++ "'spec") Spec

    getContract fn typ =
      maybe [] (getRule typ)
        (find (\fd -> snd (funcName fd) == fn) specs)

    getRule typ f@(CFunc     _ ar _ (CQualType _ ftype) rules) =
      map (\rule -> (typ, (funcName f, etaExpand ar (length (argTypes ftype)) rule))) rules
    getRule typ f@(CmtFunc _ _ ar _ (CQualType _ ftype) rules) =
      map (\rule -> (typ, (funcName f, etaExpand ar (length (argTypes ftype)) rule))) rules

    etaExpand arity tarity rule = case rule of
      CRule ps (CSimpleRhs exp ldecls) ->
        if arity == tarity
          then rule
          else let evars = map (\i -> (i,"x"++show i)) [(arity+1) .. tarity]
                in CRule (ps ++ map CPVar evars)
                         (CSimpleRhs (foldl CApply exp (map CVar evars)) ldecls)
      _ -> rule -- don't do it for complex rules

    getProp propdecl = map (\rule -> (Prop, (funcName propdecl, rule))) (funcRules propdecl)

isPropSpecFun :: CFuncDecl -> Bool
isPropSpecFun fdecl = isPropFun fdecl || isSpecFun fdecl

-- | Is a function definition a property function?
isPropFun :: CFuncDecl -> Bool
isPropFun fdecl = fst (funcName fdecl) /= easyCheckModule
               && isPropType ty && funcVis fdecl == Private
 where
    isPropType :: CTypeExpr -> Bool
    isPropType ct =  ct =~~= CTCons (easyCheckModule,"Prop") -- I/O test?
                  || ct =~~= CTCons (propModule,"Prop")      -- I/O test?
                  || resultType ct =~~= CTCons (easyCheckModule,"Prop")
                  || resultType ct =~~= CTCons (propModule,"Prop")
    easyCheckModule = "Test.EasyCheck"
    propModule      = "Test.Prop.Types"
    CQualType _ ty = funcType fdecl

-- | Is a function definition part of a specification, i.e.,
--   a full specification (suffix 'spec), a precondition (suffix 'pre),
--   or a postcondition (suffix 'post)?
isSpecFun :: CFuncDecl -> Bool
isSpecFun fdecl =
  let rfname = reverse (snd (funcName fdecl))
   in any (`isPrefixOf` rfname) ["ceps'","erp'","tsop'"]
      && funcVis fdecl == Private