-----------------------------------------------------------------------------
-- Definition of the various analyses contained in the browser.
--
-- To modify or extend the analysis functionality of the browser,
-- add access to a new analysis here and recompile the browser.
-----------------------------------------------------------------------------

module BrowserAnalysis
  ( moduleAnalyses, allFunctionAnalyses, functionAnalyses
  , viewDependencyGraph )
 where

import Data.List            ( nub, (\\) )

import FlatCurry.Types
import FlatCurry.Goodies    ( funcName )
import FlatCurry.Show       ( showFlatFunc, showFlatProg )

import AddTypes             ( addTypeSignatures )
import Analysis.Types       ( AOutFormat(..) )
import CASS.Server          ( analyzeFunctionForBrowser )
import CASS.Registry        ( functionAnalysisInfos )
import Data.GraphViz
import FlatCurry.ShowIntMod
import System.CurryPath     ( runModuleActionQuiet )

import BrowserAnalysisTypes
import CurryBrowseAnalysis.Overlapping
import CurryBrowseAnalysis.PatternComplete
import CurryBrowseAnalysis.SolutionComplete
import CurryBrowseAnalysis.Nondeterminism
import CurryBrowseAnalysis.Dependency
import CurryBrowseAnalysis.Indeterminism
import CurryBrowseAnalysis.CalledByAnalysis
import CurryBrowseAnalysis.Linearity

infix 1 `showWith`,`showWithMsg`

-------------------------------------------------------------------------------
-- The list of all available analyses for individual modules.
-- Each analysis must return a string representation of its analysis result
-- or an IO action to show the result.
moduleAnalyses :: [(String, ModuleAnalysis ModuleAnalysisResult)]
moduleAnalyses =
 [("Interface",
   InterfaceAnalysis (\int -> ContentsResult CurryProg (showInterface False int)))
  --("Write Interface",
  -- InterfaceAnalysis (\int -> ModuleAction (putStrLn (showInterface False int)))),
  --("Read source file",
  -- SourceCodeAnalysis (\fname -> readFile fname >>= \prog ->
  --                               return (ContentsResult CurryProg prog))),
  ,("Curry code (generated from FlatCurry)",
   FlatCurryAnalysis (\prog -> ContentsResult CurryProg (showCurryModule prog)))
  ,("Source program with type signatures added", SourceCodeAnalysis addTypes)
  ,("FlatCurry code",
   FlatCurryAnalysis (\prog -> ContentsResult CurryProg (showFlatCurry prog)))
  ,("FlatCurry expression",
   FlatCurryAnalysis (\prog -> ContentsResult FlatCurryExp (showFlatProg prog)))
  ]

addTypes :: String -> IO ModuleAnalysisResult
addTypes fname
  | take 7 (reverse fname) == "yrrucl."
  = return (ContentsResult OtherText "Can't add types to literate programs")
  | otherwise
  = do prog <- runModuleActionQuiet addTypeSignatures fname
       return (ContentsResult CurryProg prog)

-----------------------------------------------------------------------------
-- The list of all available analyses for individual functions.
-- Each analysis must return a string or an IO action representation of its
-- analysis result.
functionAnalyses :: [(String, FunctionAnalysis AnalysisResult)]
functionAnalyses =
 [("Curry code",        LocalAnalysis     (MsgResult . showFuncDeclAsCurry)),
  --("Print Curry code",  withAction (LocalAnalysis (putStr . showFuncDeclAsCurry))),
  --("Print func name",   withAction (GlobalAnalysis printFuncName)),
  ("FlatCurry code",    LocalAnalysis     (MsgResult . showFuncDeclAsFlatCurry)),
  ("FlatCurry expression",LocalAnalysis   (MsgResult . showFlatFunc)),
  ("Calls directly",    LocalAnalysis     callsDirectly `showWithMsg`
       showQDep "Calls the following functions directly in the right-hand sides:"),
  ("Depends on",        GlobalAnalysis    indirectlyDependent `showWithMsg`
       showQDep "Depends on the following functions:"),
  ("Depends on externals", GlobalAnalysis  externalDependent `showWithMsg`
       showQDep "Depends on the following external functions:"),
  ("Dependency graph (DOT)", withAction (GlobalAnalysis viewFuncDepGraphs)),
  ("Local dependency graph (DOT)", withAction (GlobalAnalysis viewFuncLocalDepGraphs)),
  ("Called by",         GlobalAnalysis    calledBy `showWithMsg`
       showDep "Is called by the following functions of the current module:")] ++
 map (\ (aname,atitle) -> (atitle++" (CASS)", withCASS aname))
     functionAnalysisInfos ++
 [("Overlapping rules",
   LocalAnalysis     isOverlappingFunction   `showWithMsg` showOverlap),
  ("Right-linear rules",
   LocalAnalysis     hasRightLinearRules     `showWithMsg` showLinear),
  ("Right-linearity",
   GlobalAnalysis    analyseRightLinearity   `showWithMsg` showLinearity),
  ("Pattern completeness",
   LocalDataAnalysis analyseCompleteness     `showWithMsg` showComplete),
  ("Totally defined",
   GlobalDataAnalysis analyseTotallyDefined  `showWithMsg` showComplete),
  ("Solution complete",
   GlobalAnalysis    analyseSolutionComplete `showWithMsg` showOpComplete),
  ("Nondeterministic",
   GlobalAnalysis    analyseNondeterminism   `showWithMsg` showNondet),
  ("Set-valued",        GlobalAnalysis    analyseSetValued `showWithMsg` showSetValued),
  ("Purity",            GlobalAnalysis    analyseIndeterminism `showWithMsg` showIndet)]

-----------------------------------------------------------------------------
-- The list of all available analyses for sets of functions.
-- Each analysis must return a short(!) string representation (no more than a few chars)
-- of its analysis result that is prefixed to the function name in the list
-- of function. The second (String) component of each analysis entry is a short
-- explanation of the used prefixes.
allFunctionAnalyses :: [(String, String, FunctionAnalysis String)]
allFunctionAnalyses =
 [("Overlapping rules",
   "Meaning of function markings:\n\n"++
   "OVL>>>  : defining rules overlap\n\n"++
   "unmarked: no overlapping rules",
   LocalAnalysis     isOverlappingFunction `showWith` showBool "OVL>>>" ""),
  ("Pattern completeness",
   "Meaning of function markings:\n\n"++
   "INCMP>>> : possibly incompletely defined operation\n\n"++
   "unmarked : completely defined operation",
   LocalDataAnalysis analyseCompleteness   `showWith` showCompleteS),
  ("Totally defined",
   "Meaning of function markings:\n\n"++
   "PARTIAL>>> : possibly partially defined operation\n\n"++
   "unmarked : totally defined operation",
   GlobalDataAnalysis analyseTotallyDefined `showWith` showTotally),
  ("Solution complete",
   "Meaning of function markings:\n\n"++
   "SUSP>>> : operation may suspend\n\n"++
   "unmarked: operation does not suspend",
   GlobalAnalysis    analyseSolutionComplete `showWith` showBool "" "SUSP>>>"),
  ("Nondeterministic",
   "Meaning of function markings:\n\n"++
   "ND>>>   : nondeterministic operation\n\n"++
   "unmarked: deterministic operation",
   GlobalAnalysis    analyseNondeterminism `showWith` showBool "ND>>>" ""),
  ("Right-linearity",
   "Meaning of function markings:\n\n"++
   "RL>>>   : defined by right-linear rules and depend only on\n"++
   "          right-linear functions\n\n"++
   "unmarked: possibly non-right-linear",
   GlobalAnalysis    analyseRightLinearity `showWith` showBool "RL>>>" ""),
  ("Set-valued",
   "Meaning of function markings:\n\n"++
   "SET>>>  : set-valued operation\n\n"++
   "unmarked: single-valued operation",
   GlobalAnalysis    analyseSetValued      `showWith` showBool "SET>>>" ""),
  ("Purity",
   "Meaning of function markings:\n\n"++
   "IMP>>>  : impure (indeterministic) operation\n\n"++
   "unmarked: referentially transparent operation",
   GlobalAnalysis    analyseIndeterminism  `showWith` showBool "IMP>>>" "")]

-- This function is useful to integrate an existing program analysis
-- into the browser by providing a transformation of the analysis results
-- into strings:
showWith :: FunctionAnalysis a -> (a->String) -> FunctionAnalysis String
showWith (LocalAnalysis ana) showresult =
   LocalAnalysis (\f -> showresult (ana f))
showWith (LocalDataAnalysis ana) showresult =
   LocalDataAnalysis (\types f -> showresult (ana types f))
showWith (GlobalAnalysis ana) showresult =
   GlobalAnalysis (\funs -> map (\(name,res)->(name,showresult res)) (ana funs))
showWith (GlobalDataAnalysis ana) showresult =
   GlobalDataAnalysis (\types funs -> map (\(name,res)->(name,showresult res))
                                          (ana types funs))

showWithMsg :: FunctionAnalysis a -> (a->String) -> FunctionAnalysis AnalysisResult
showWithMsg (LocalAnalysis ana) showresult =
   LocalAnalysis (\f -> MsgResult (showresult (ana f)))
showWithMsg (LocalDataAnalysis ana) showresult =
   LocalDataAnalysis (\types f -> MsgResult (showresult (ana types f)))
showWithMsg (GlobalAnalysis ana) showresult =
   GlobalAnalysis (\funs -> map (\(name,res)->(name,MsgResult (showresult res)))
                                (ana funs))
showWithMsg (GlobalDataAnalysis ana) showresult =
   GlobalDataAnalysis (\types funs -> map (\(name,res)->(name,MsgResult (showresult res)))
                                          (ana types funs))

-- Shows a Boolean result:
showBool :: String -> String -> Bool -> String
showBool t _ True  = t
showBool _ f False = f

-- Shows the result of the overlapping analysis.
showOverlap :: Bool -> String
showOverlap True  = "Overlapping"
showOverlap False = "Not Overlapping"

-- Shows the result of the right-linear rules analysis.
showLinear :: Bool -> String
showLinear True  = "Defined by right-linear rules"
showLinear False = "Definition contains non-right-linear rules"

-- Shows the result of the right-linearity analysis.
showLinearity :: Bool -> String
showLinearity True  = "Defined by functions with right-linear rules"
showLinearity False = "Defined by functions containing non-right-linear rules"

-- Shows the result of the completeness analysis.
showComplete :: CompletenessType -> String
showComplete Complete     = "completely defined (i.e., reducible on all constructors)"
showComplete InComplete   = "incompletely defined"
showComplete InCompleteOr =
                    "incompletely defined in each disjunction (but might be complete)"

showCompleteS :: CompletenessType -> String
showCompleteS Complete     = ""
showCompleteS InComplete   = "INCMP>>>"
showCompleteS InCompleteOr = "INCMP>>>"

-- Shows the result of the totally-defined analysis.
showTotallyDefined :: CompletenessType -> String
showTotallyDefined Complete     = "totally defined (i.e., reducible to a value)"
showTotallyDefined InComplete   = "partially defined"
showTotallyDefined InCompleteOr = "partially defined"

showTotally :: CompletenessType -> String
showTotally Complete     = ""
showTotally InComplete   = "PARTIAL>>>"
showTotally InCompleteOr = "PARTIAL>>>"

-- Shows the result of the operational completeness analysis.
showOpComplete :: Bool -> String
showOpComplete True  = "All solutions can be computed"
showOpComplete False = "Evaluation might suspend"

-- Shows the result of the indeterminism analysis.
showIndet :: Bool -> String
showIndet True  = "Impure (indeterministic) operation"
showIndet False = "Referentially transparent"

-- Shows the result of the non-determinism analysis.
showNondet :: Bool -> String
showNondet True  = "Operation might be nondeterministic"
showNondet False = "Deterministic operation"

-- Shows the result of the set-valued analysis.
showSetValued :: Bool -> String
showSetValued True  = "Operation might be set-valued"
showSetValued False = "Single-valued operation"

-- Shows the result of a dependency analysis with title.
showQDep :: String -> [QName] -> String
showQDep title fnames = title ++ "\n" ++ unlines (map (\(m,n)->m++"."++n) fnames)

-- Shows the result of a dependency analysis with title without qualifiers.
showDep :: String -> [QName] -> String
showDep title fnames = title ++ "\n" ++ unlines (map snd fnames)

-- Visualize the result of the dependency graph analysis.
viewFuncDepGraphs :: [FuncDecl] -> [(QName,IO ())]
viewFuncDepGraphs fdecls =
  map (\(f,fgraph)->(f,showDGraph f (isExternal fdecls) fgraph))
      (dependencyGraphs fdecls)

isExternal :: [FuncDecl] -> QName -> Bool
isExternal [] _ = True -- this case should not occur
isExternal (Func g _ _ _ rule : gs) f = if f==g then isExternalRule rule
                                                else isExternal gs f
 where
   isExternalRule (Rule _ _) = False
   isExternalRule (External _) = True

-- Visualize the result of the local dependency graph analysis.
viewFuncLocalDepGraphs :: [FuncDecl] -> [(QName,IO ())]
viewFuncLocalDepGraphs fdecls =
  map (\(f,fgraph)->(f,showDGraph f (\(m,_)->m/=fst f) fgraph))
      (localDependencyGraphs fdecls)

showDGraph :: QName -> (QName->Bool) -> [(QName,[QName])] -> IO ()
showDGraph (mod,_) isExt fnames =
   viewDependencyGraph
       (map (\(f,gs)->(showLocalName f,
                       if isExt f then extAttrs else [],
                       map showLocalName gs))
            fnames)
 where
  showLocalName (m,g) = if m==mod then g else m++'.':g

  -- dot attributes for visualization of external function nodes:
  extAttrs = [("style","filled"),("color",".7 .3 1.0")]

viewDependencyGraph :: [(String,[(String,String)],[String])] -> IO ()
viewDependencyGraph deps = viewDotGraph $ dgraph "dependencies" nodes edges
 where
  nodes = map (\ (n,a,_) -> Node n a) deps ++
          map (\ n -> Node n [])
              (concatMap (\ (_,_,ts) -> ts) deps \\ map (\ (n,_,_) -> n) deps)
  edges = map (\ (s,t) -> Edge s t [])
              (nub (concatMap (\ (p,_,ds) -> map (\d -> (p,d)) ds) deps))

--------------------------------------------------------------------------------
-- Auxiliary operation to integrate a CASS analysis for an individual
-- operation.
withCASS :: String -> FunctionAnalysis AnalysisResult
withCASS ananame =
  LocalAnalysis (\f -> ActionResult (analyzeFunctionWithCASS f))
 where
   analyzeFunctionWithCASS (Func f _ _ _ _) =
     analyzeFunctionForBrowser ananame f AText

--------------------------------------------------------------------------------
-- This function is useful to integrate an existing program analysis
-- with result type (IO a) into the browser by providing a transformation
-- of the analysis results.
withAction :: FunctionAnalysis (IO _) -> FunctionAnalysis AnalysisResult
withAction (LocalAnalysis ana) =
   LocalAnalysis (\f -> ActionResult (ana f >> return ""))
withAction (LocalDataAnalysis ana) =
   LocalDataAnalysis (\types f -> ActionResult (ana types f >> return ""))
withAction (GlobalAnalysis ana) =
   GlobalAnalysis
     (\funs -> map (\(name,res) -> (name,ActionResult (res >> return "")))
                   (ana funs))
withAction (GlobalDataAnalysis ana) =
   GlobalDataAnalysis
     (\types funs -> map (\ (name,res) -> (name,ActionResult (res>>return "")))
                         (ana types funs))

-- A simple example for a global function analysis of type IO:
printFuncName :: [FuncDecl] -> [(QName,IO ())]
printFuncName =
  map (\fdecl -> (funcName fdecl, putStrLn (snd (funcName fdecl))))