Analyze.hs

-----------------------------------------------------------------------------
-- |
-- Module      :  Windll
-- Copyright   :  (c) Tamar Christina 2009 - 2010
-- License     :  BSD3
-- 
-- Maintainer  :  tamar@zhox.com
-- Stability   :  experimental
-- Portability :  portable
--
-- This module contains code to analyze datatypes in order to generate
-- QuickCheck arbitrary instances.
--
-----------------------------------------------------------------------------

module Tests.Exec.Analyze where

import WinDll.Identifier
import WinDll.Utils.Feedback
import WinDll.Session.Hs2lib
import WinDll.Structs.Structures

import Data.Monoid

import Tests.Exec.Structs

-- | Measure the costs of the datatypes of modules and 
--   create the generator functions for these types.
analyzeModule :: Exec [Arbitrary]
analyzeModule 
  = do modinfo <- generateMain
       let (normal, special) = modDatatypes modinfo
           values            = normal `mappend` special
       datatypes <- mapM (measureCost values) values
       
       mapM (liftIO . print) datatypes
       
       return datatypes
       
-- | Measure the costs of the datatype's constructor 
--   so we know how to generate instances of the datatype
measureCost :: DataTypes -> DataType -> Exec Arbitrary
measureCost lst dtype 
  = do let atype x = Arbitrary { arName  = dtName dtype
                               , arVars  = dtVars dtype
                               , arCons  = x
                               , arCosts = (0,0)
                               , arTag   = dtTag dtype
                               }
           consts  = getConstructors dtype
       
       arbs <- mapM (getConCost lst) consts
       
       let costs = getTypeCosts arbs
       
       return $ (atype arbs){arCosts = costs}
                               
-- | Get the minimum and maximum costs of a type by looking at the
--   costs of the constructors of the type.
getTypeCosts :: Arbitraries -> (Int, Int) 
getTypeCosts [] = (0,0)
getTypeCosts ((v@Variant{}):xs) = let cost               = arCost v
                                      (minCost, maxCost) = getTypeCosts xs
                                  in (minCost `min` cost, maxCost `max` cost)
getTypeCosts _  = (0,0)
                               
-- | returns the constructors of a type
getConstructors :: DataType -> DataTypes
getConstructors (DataType _ _ x _) = x
getConstructors (NewType  _ _ x _) = [x]
getConstructors (x@Constr{})       = [x]

-- | Get the cost of the constructors.
getConCost :: DataTypes -> DataType -> Exec Arbitrary
getConCost lst (Constr n f ann) 
   = do let var = Variant { arCost  = 0
                          , arName  = n
                          , arFix   = f
                          , arNamed = []
                          }
        return var
getConCost _ _ = die "getConCost can only determine the cost of constructors. try 'measureCost' instead"