{- 

Author: Wishnu Prasetya, Joao Amorim

Copyright 2010 Wishnu Prasetya

The use of this sofware is free under the GNU General Public License
(GPL) version 3.

-}

module CTy.Utils where

import Data.Maybe
import CTy.CRule

-- | To count the maximum number of combinations induced by a classification tree.
nCombs :: CTree tv -> Int
nCombs (ClsTree cats) = worker cats
   where
   worker  []    = 1
   workern (c:t) = length (classesOfCat c) * worker t

-- | To count the number of categories in a classification tree.
nCats :: CTree tv -> Int
nCats (ClsTree cats) = length cats

-- | To count the number of classes in a classification tree.
nClasses :: CTree tv -> Int
nClasses (ClsTree cats) = worker cats
   where
   worker   []  = 0
   worker (c:t) = length (classesOfCat c) + worker t


-- | Get the classes of a partition.
classesOfPartition :: Partition tv -> [Class tv]
classesOfPartition (Leaf c tv)     = [(c,tv)]
classesOfPartition (Node _  ps) = concat (map classesOfPartition ps)

-- | get the classes of a category.
classesOfCat :: Category tv -> [Class tv]
classesOfCat (Cat _ cs) = concat (map classesOfPartition cs)

-- | Get the classes of a category, then turn them to singular test-cases.
getSingTestCases :: Category tv -> Suite tv
getSingTestCases (cat@(Cat cname _)) = classes2suite cname (classesOfCat cat)

-- | Get the classes of category/partition/class, given its name.
classesOf :: CTree tv -> String -> [Class tv]
classesOf (ClsTree [])   _ = []
classesOf (ClsTree cats) n = worker cats
    where
    worker (c:cs) = case search c of
       Just z -> z
       _      -> worker cs


    search c@(Cat n' ps) = if n==n' then Just (classesOfCat c) else searchPS ps

    searchPS [] = Nothing
    searchPS (p:ps) = case searchP p of
        Just z -> Just z
        _      -> searchPS ps

    searchP p@(Node n' ps) = if n==n' then Just (classesOfPartition p) else searchPS ps
    searchP (Leaf n' tv)    = if n==n' then Just [(n,tv)] else Nothing


-- | lift a set of classes to a suite of singular test-cases.
classes2suite :: CategoryName -> [Class tv] -> Suite tv
classes2suite cn cs = map (\(c,tv)-> [(cn,c,tv)]) cs

-- | Get the categories' names of a given classification tree.
catNames :: CTree tv -> [String]
catNames (ClsTree cats) = map (\(Cat n _)-> n) cats

-- | Get the partition names, including those of classes underneath
-- a given root partition.
getNames :: Partition tv -> [String]
getNames (Leaf n _) = [n]
getNames (Node n ts) = n : concat (map getNames ts)


-- | Return the (name of) category of a given class/partition/category-name
catOf :: CTree tv -> String -> Maybe CategoryName
catOf (ClsTree [])   _  = Nothing
catOf ct@(ClsTree cats) n  = if n `elem` catNames ct then Just n else search cats
   where
   search [] = Nothing
   search (c@(Cat cname partitions) : cs) =
      if n `elem` concat (map getNames partitions) then Just cname
      else search cs

catOf_ ct n = fromJust (catOf ct n)

-- | Return the categories that a give Rule constrains.
catsInRule :: CTree tv -> Rule -> [String]
catsInRule ct (All c)      = [c]
catsInRule ct (Include ps) = map (fromJust . catOf ct) ps
catsInRule ct (Neg p)      = catsInRule ct p
catsInRule ct (Andp p q)   = catsInRule ct p ++ catsInRule ct q
catsInRule ct (Andm p q)   = catsInRule ct p ++ catsInRule ct q
catsInRule ct (Union p q)  = catsInRule ct p ++ catsInRule ct q
catsInRule ct (Intersect p q) = catsInRule ct p ++ catsInRule ct q


-- | For showing a suite; will not show the concrete test-values.
showSuite :: Suite tv -> String
showSuite []    = ""
showSuite [x]   = showComb x
showSuite (h:t) = showComb h ++ "\n" ++ showSuite t

printSuite = putStr . showSuite

-- | For showing a combination; will not show the concrete test-values.
showComb :: TestCase tv -> String
showComb []  = "< >"
showComb [(_,x,_)] = "< " ++ x ++ " >"
showComb ((_,x,_):s) = "< " ++ x ++ worker s ++ " >"
  where
  worker s = concat . map format $ s
  format (_,x,_) = ", " ++ x

-- defining a separate equality to compare members of Class_ based on the 
-- class name
(_,n1,_) `clEqual` (_,n2,_) =  n1==n2

tc1 `covers` tc2 = all occur tc2
   where
   occur c2 = any (clEqual c2) tc1

tc1 `coveredBy` tc2 = tc2 `covers` tc1