{-# LANGUAGE OverloadedStrings #-}
{-|
Module : TestExplode.TestExplode
Description : Definitions of part-testcases, graphs of them, and an evaluation function to generate complete testcases (strings).
Copyright : (c) Hans-Jürgen Guth, 2014
License : LGPL
Maintainer : juergen.software@freea2a.de
Stability : experimental

With this module you can define a graph of part-testcases
('Casepart') and evaluate this graph to a list of strings,
where every string is the concatenation of the code of the
part-testcases.
-}

module TestExplode.TestExplode (
                    -- * Types
                    Casepart(Casepart)
                    , shortDesc
                    , longDesc
                    , condDesc
                    , codeFkt
                    , varFkt
                    , condition
                    , CasepartInternal(CasepartInternal)
                    , shortDescI
                    , longDescI
                    , condDescI
                    , codeFktI
                    , conditionI
                    , CPType(NormalCP, Mark)
                    , cpType
                    , cpTypeI
                    , DirGraph(SimpleDG, Conc, Join, StructDG)
                    , SplittedGraph(Split)
                    , Testgraph(Testgraph)
                    , dirGraph
                    , docuInfo
                    , TGDocuInfo(TGDocuInfo)
                    , name
                    , descForNode
                    , descForTex
                    , generic
                    , toExpand
                    , Expand (Expand, NotExpand, AsIs)                  
                    -- * Functions
                    , generate
                    , emptyCp
                    , markCp
                    , getSubGraphs                 
                    -- * Functions for generating 'DirGraph' s 
                    -- The non-graphical-UI for the user.
                    -- Call it a EDSL, if you like
                    , mkEle
                    , (&-&)
                    , conc
                    , split
                    , mkGraph2Ele
                    , mkGraph2Ele0
                    -- * Conversion Functions
                    , convertDirGraph
                    , convertTestgraph  
                    ) where
 
import Control.Monad.Writer 
import qualified Data.Text.Lazy as L
import qualified Data.Sequence as S
import qualified Data.Foldable as DF                  

-- | The part-testcase
data Casepart cnf     -- the test data
              locals  -- test hints, that are changed by a Casepart
                      --  for example  the state of a state machine
                      --  or the time since start of the Testcase  
              = Casepart 
                  { 
                    -- | short description of the part-testcase,
                    -- currently used  a) at top of a testcase to show
                    -- which path the generated testcase belongs to
                    -- and b) in the visualised graph as node-label  
                    shortDesc :: L.Text
                    -- | long description of the part-testcase
                    -- currently generated in front of the code of the
                    -- part-testcase
                    , longDesc :: L.Text
                    -- | description of the condition, under which
                    -- the part-testcase is valid (if not, the path with
                    -- this part-testcase will not be generated)
                    , condDesc :: L.Text
                    -- | the actual code, which forms the part-testcase,
                    -- dependent of the "configuration" (the  "cnf" in 
                    -- 'Casepart cnf locals'), which is the test-data, 
                    -- and local variables, that are changed by a Casepart.
                    , codeFkt :: cnf -> locals -> L.Text
                    -- | The changes in the local variables
                    , varFkt :: cnf -> locals -> locals
                    -- | the condition under which the part-testcase
                    -- is valid (if not, the path with
                    -- this part-testcase will not be generated)
                    , condition :: cnf -> locals -> Bool
                    -- | Type of the Casepart, mainly (up to now only) for
                    -- visualisation in the graph of Caseparts
                    , cpType :: CPType
                  }
                  
-- | The part-testcase, internal format of 'Casepart', with a writer-monad as stringFkt 
-- instead of the varFkt and the old stringFkt
data CasepartInternal cnf locals = CasepartInternal 
                  { 
                    shortDescI :: L.Text
                    , longDescI :: L.Text
                    , condDescI :: L.Text
                    , codeFktI :: cnf -> locals -> Writer (S.Seq L.Text) locals
                    , conditionI :: cnf -> locals -> Bool
                    , cpTypeI :: CPType
                  }                  
                  
-- | Types of Caseparts, mainly (up to now only) for
-- visualisation of the graph of Caseparts
data CPType = NormalCP | Mark
  deriving (Show, Eq)
                  
-- | An empty testcase, all strings are "".
--  The condition is always 'True'.
--  Shall serve as an starting point for own definitions of
-- 'Casepart''s.
emptyCp = Casepart {  shortDesc = ""
                    , longDesc = ""
                    , condDesc =""
                    , codeFkt = \cnf locals -> ""
                    , varFkt = \cnf locals -> locals 
                    , condition = \cnf locals -> True
                    , cpType = NormalCP
                    } 

                   
-- | Convenience Function to make easily a mark.
--                   
markCp str = emptyCp { shortDesc = L.append "Mark: " str,
                       longDesc = "Set a mark",
                       codeFkt = \cnf locals -> L.concat["  setCheckMark(\"",
                                                         str,
                                                         "\");\n"],
                       cpType = Mark
                     }                  
-- | The heart of this module, the final function.
--  It takes configurations ('cnf' means testvalues),
--  that is a record of variables with a
-- value, a function that describes the "prelude" of one testcase (without
-- comment chars, which are later added) (a good starting value : the 
-- 'show'-function of 'cnf', so that the used test-values are printed on top
-- of the testcase), the graph of testcases and returns 
-- 
-- voilá:
--
-- the 
-- list of testcases, ready to printed out in seperate files and to run.
generate ::  L.Text     -- ^ how a text is coomented, ("# " or "-- ")
             -> [cnf]   -- ^ a list of the testvalues
             -> locals  -- ^ the initial value of the variables that the
                        --   testcases change
             -> (cnf -> L.Text) -- ^ "prelude" of a testcase, i.e. 'show' of cnf
             -> DirGraph (CasepartInternal cnf locals)  -- ^ the graph of caseparts
             -> [L.Text]  -- ^ the final result: the list of testcases incl. comments
generate commentString cnfList locals cnfShow graph = 
        [L.concat[mkComment(L.concat[(cnfShow cnf),"\n", desc]) commentString,
                  DF.fold $ snd $ runWriter (stringFkt cnf locals)
                 ] | 
                         cnf <- cnfList,
                         -- Casepart stringFkt cond <- cpGetPaths graph,
                         -- cond cnf] 
                         --
                         -- Does this work too? is independent of the 
                         --   structure, uses record syntax
                         let cpList = cpGetPaths commentString graph,
                         (stringFkt, cond, desc) <- map getCodeAndConditionAndDesc cpList, 
                         cond cnf locals]
                      
-- | Internal help function, could be made more general for
--   arbitrary getter functions and number of getter functions 
getCodeAndConditionAndDesc :: CasepartInternal a b -> 
                              ((a -> b -> Writer (S.Seq L.Text) b), (a -> b ->Bool), L.Text)
getCodeAndConditionAndDesc cp =  (codeFktI cp, conditionI cp, shortDescI cp)

-- | Internal function to comment the description with the commentString
mkComment :: L.Text -> L.Text -> L.Text
--mkComment str  = let strNew = "# " ++ str
--                in
--                  Utils.replace "\n" "\n# " str
mkComment str commentString = L.unlines $ map (L.append commentString ) (L.lines str)

 
-- Now all the functions for combinating Casepart's

-- | Directed graph with one end, self-invented definition
data DirGraph a =        -- | Constructor for a node alone, 
                         --  A node is a graph. 
                         SimpleDG a | 
                         -- | Constructor for one sub-graph after another
                         Conc (DirGraph a) (DirGraph a) | 
                         -- | Constructor for the "splitting" of graphs,
                         -- comparable with an "if".
                         -- The 'Join' makes the many ends and begins 
                         -- to one end and one begin
                         Join (SplittedGraph a) |
                         -- | A graph with more attributes,
                         --   importing of a 'Testgraph', only the part
                         --   'dirGraph' is used
                         StructDG (Testgraph a)

-- | many disjunct graphs 
-- Every part-graph has one end and one begin
data SplittedGraph a = Split [DirGraph a]

-- shorthand:
-- type CPDirGraph = DirGraph (Casepart cnf)

-- to build a directed graph:
-- at best:
-- ele1 conc ele2 conc (split [ele3, ele4, split [ele5, ele6], ele7]) conc ele8
--
-- this leads to::
-- eleN is a SimpleDG
-- conc can be infix: `conc`
-- the end of an split is a `join`

-- | Function to create a splitted graph 
split :: [DirGraph a] -> DirGraph a
split x = Join (Split x)

-- | Function to craete a 'Conc' of two sub-graphs
conc :: DirGraph a -> DirGraph a -> DirGraph a
conc a b = Conc a b

-- | Infix synonym for 'conc'
(&-&) :: DirGraph a -> DirGraph a -> DirGraph a
a &-& b = Conc a b

-- | Function to create a node, Internal, with the CasepartInternal as 'a'
mkEleInt :: a -> DirGraph a
mkEleInt a = SimpleDG a

-- | Function to create a node, function for the user.
--   If longDesc = "", shortDesc is used as longDesc.
mkEle :: Casepart cnf locals -> DirGraph (CasepartInternal cnf locals)
mkEle cpUser = mkEleInt (CasepartInternal {shortDescI = shortDesc cpUser,
                                   longDescI = if longDesc cpUser == "" 
                                               then shortDesc cpUser
                                               else longDesc cpUser,
                                   condDescI = condDesc cpUser,
                                   codeFktI = mkLogging  (codeFkt cpUser) (varFkt cpUser),
                                   conditionI = condition cpUser,
                                   cpTypeI    = cpType cpUser
                                  })
                                  
                                  
-- | Internal Function to build the monad-function as the new codeFkt
mkLogging :: (cnf -> locals -> L.Text)        -- ^ the old codeFkt
              -> (cnf -> locals -> locals)    -- ^ the change-function of the variables  (old varFkt)
              ->  (cnf -> locals -> Writer (S.Seq L.Text) locals)  -- ^ the new codeFkt
mkLogging fText fVars =  \cnf locs ->  
                           let ret = fVars cnf locs
                           in
                           do tell $ S.singleton $ fText cnf locs
                              return ret



data Expand = Expand | NotExpand | AsIs

-- | Function to add a testgraph to a dirgraph
-- with converting-function f of the testdata ("cnfOld" resp. "cnfNew")
-- and a Boolean, that says, if the subgraph should be 
-- expanded or not.
mkGraph2Ele :: (cnfNew -> cnfOld) -- ^ conversion function for the test-data-input of the casepart
               -> (localsInB -> localsInA) -- ^ conversion function for the 
                                           --   variables the testcases uses/changes (input-side)
               -> (localsInB -> localsInA -> localsInB) -- ^ conversion function for the 
                                               --   variables the testcases uses/changes (output-side)
                                               -- that is: how shall the variables look after the run 
                                               --  of the casepart? Dependant of the old value
                                               -- of the variables and the value of the variables after run
                                               -- of the imported testcase
               -> Expand  -- ^ Shall this Graph in the documation expanded or not ?
               -> Testgraph (CasepartInternal cnfOld localsInA) -- ^ the Testgraph that shall be imported
               -> DirGraph (CasepartInternal cnfNew localsInB) -- ^ the imported Testgraph, now a DirGraph
                                                               -- with the correct types
mkGraph2Ele fCnf fLocIn fLocOut expand tg = 
               let newTg = case expand of
                     AsIs      -> tg
                     NotExpand -> tg {docuInfo=(docuInfo tg) {toExpand=False}}
                     Expand    -> tg {docuInfo=(docuInfo tg) {toExpand=True}}
               in              
               StructDG ( convertTestgraph fCnf fLocIn fLocOut newTg)
               
               
-- | Function to add a testgraph to a dirgraph
-- without converting-function
mkGraph2Ele0 :: Testgraph a 
                -> DirGraph a
mkGraph2Ele0 tg = StructDG tg


-- | The eval function of the EDSL. Evaluates a 'DirGraph' to the list 
-- of all paths.
cpGetPaths ::  L.Text -> DirGraph (CasepartInternal cnf locals ) -> [CasepartInternal cnf locals]
cpGetPaths commentString (SimpleDG cp) = 
          let lngDesc = longDescI cp
              cdFkt = codeFktI cp
          in 
          -- insert longDesc before codeFkt
          [cp{codeFktI = \cfg locals -> do 
                                          tell $ S.singleton "\n"
                                          tell $ S.singleton $ mkComment lngDesc commentString
                                          cdFkt cfg locals
             }] 
   
cpGetPaths commentString (Conc dirGraph1 dirGraph2) =
   let paths1 = cpGetPaths commentString dirGraph1
       paths2 = cpGetPaths commentString dirGraph2
       in 
         [CasepartInternal { 
                    longDescI="" -- not relevant for combined part-testcases
                    ,condDescI="" -- not relevant for combined part-testcases
                    ,cpTypeI = NormalCP -- not relevant for combined part-testcases
                    ,shortDescI = L.concat[shortDescI cp1,
                                           "\n and\n",
                                          shortDescI cp2]
                    ,codeFktI = \cnf locals ->  do 
                                                vars1 <- (codeFktI cp1) cnf locals
                                                (codeFktI cp2) cnf vars1
                    ,conditionI = \cnf locals -> (((conditionI cp1) cnf locals) && ((conditionI cp2) cnf locals))} |
                       cp1 <- paths1,
                       cp2 <- paths2 ] -- jeder mit jedem
                       
cpGetPaths commentString (StructDG tg) = cpGetPaths commentString (dirGraph tg)
                                                      
cpGetPaths commentString (Join (Split paths )) =  concat $ lcpGetPaths commentString (Split paths)

-- | the eval function of the EDSL for SplittedGraphs   
lcpGetPaths :: L.Text -> SplittedGraph (CasepartInternal cnf locals) -> [[CasepartInternal cnf locals]]
lcpGetPaths commentString (Split paths) = map (cpGetPaths commentString) paths


-- | Converts between Caseparts.
-- You need a interpreting from the target data-type to the
-- source data-type (not vice versa) 
convertCasepart :: (cnfB -> cnfA)  -- ^ conversion function for the test-data-input of the casepart
                   -> (localsInB -> localsInA) -- ^ conversion function for the 
                                               --   variables the testcases uses/changes (input-side)
                   -> (localsInB -> localsInA -> localsInB) -- ^ conversion function for the 
                                               --   variables the testcases uses/changes (output-side)
                                               -- that is: how shall the variables look after the run 
                                               --  of the casepart? Dependant of the old value
                                               -- of the variables and the value of the variables after run
                                               -- of the imported testcase
                   -> CasepartInternal cnfA localsInA -- ^ the Casepart that shall be imported
                   -> CasepartInternal cnfB localsInB -- ^ the imported Casepart with the correct types
convertCasepart fCnf fLocIn fLocOut cpa = 
                CasepartInternal { 
                                   codeFktI = \cnf locals -> do
                                                               oldIn <- (codeFktI cpa) (fCnf cnf) (fLocIn locals)
                                                               return $ fLocOut locals oldIn 
                                                             ,
                                   conditionI = \cnf locals -> (conditionI cpa) (fCnf cnf) (fLocIn locals),
                                   shortDescI = shortDescI cpa,
                                   longDescI = longDescI cpa,
                                   condDescI = condDescI cpa,
                                   cpTypeI = cpTypeI cpa                                  
                                 }
                                 
-- | Converts a DirGraph, for example our testgraphs.
-- With that function you can import other testgraphs
-- with another set of variables.  
-- You need a interpreting from the target data-type to the
-- source data-type (not vice versa)                              
convertDirGraph :: (cnfB->cnfA) -- ^ conversion function for the test-data-input of the casepart
                   -> (localsInB -> localsInA)  -- ^ conversion function for the 
                                                --   variables the testcases uses/changes (input-side)
                   -> (localsInB -> localsInA -> localsInB) -- ^ conversion function for the 
                                               --   variables the testcases uses/changes (output-side)
                                               -- that is: how shall the variables look after the run 
                                               --  of the casepart? Dependant of the old value
                                               -- of the variables and the value of the variables after run
                                               -- of the imported testcase
                   -> DirGraph (CasepartInternal cnfA localsInA) -- ^ the DirGraph that shall be imported
                   -> DirGraph (CasepartInternal cnfB localsInB) -- ^ the imported DirGraph with the correct types
convertDirGraph f fLocIn fLocOut (SimpleDG cp) = SimpleDG (convertCasepart f fLocIn fLocOut cp)
convertDirGraph f fLocIn fLocOut (Conc dg1 dg2)= Conc (convertDirGraph f fLocIn fLocOut dg1)
                                       (convertDirGraph f fLocIn fLocOut dg2)
                                    
convertDirGraph f fLocIn fLocOut (Join splittedGraph) = 
       Join ( convertSplittedGraph f fLocIn fLocOut splittedGraph)
       


-- | Converts a SplittedGraph
convertSplittedGraph :: (cnfB->cnfA)
                        -> (localsInB -> localsInA)
                        -> (localsInB -> localsInA -> localsInB) 
                        -> SplittedGraph (CasepartInternal cnfA localsInA) 
                        -> SplittedGraph (CasepartInternal cnfB localsInB)
convertSplittedGraph f fLocIn fLocOut (Split dirGraphs) =
       Split (map (convertDirGraph f fLocIn fLocOut) dirGraphs)  
       
       
-- Extensions to the modules
-- for adding parts of testgraph / subgraphs

data TGDocuInfo = 
     TGDocuInfo { name        :: String,
                  descForNode :: String,
                  descForTex  :: String,
                  generic     :: Bool,
                  toExpand    :: Bool
                }           

data Testgraph a = 
     Testgraph { dirGraph  :: DirGraph a,
                 docuInfo  :: TGDocuInfo
               }

-- | Converts a testgraph, necessary in order to add 
--  a different testgraph ( with another type of configuration)
--  to a dirGraph
convertTestgraph :: (cnfB -> cnfA)   -- ^ conversion function for the test-data-input of the casepart
                    -> (localsInB -> localsInA) -- ^ conversion function for the 
                                                --   variables the testcases uses/changes (input-side)
                    -> (localsInB -> localsInA -> localsInB) -- ^ conversion function for the 
                                               --   variables the testcases uses/changes (output-side)
                                               -- that is: how shall the variables look after the run 
                                               --  of the casepart? Dependant of the old value
                                               -- of the variables and the value of the variables after run
                                               -- of the imported testcase
                    -> Testgraph (CasepartInternal cnfA localsInA) -- ^ the Testgraph that shall be imported
                    -> Testgraph (CasepartInternal cnfB localsInB) -- ^ the imported Testgraph with the correct types            
convertTestgraph f fLocIn fLocOut tg = tg { dirGraph = convertDirGraph f fLocIn fLocOut (dirGraph tg)} 

-- | Convenience function for the case, that the return value of an 
--   embedded 'Casepart' shall have no effect. The old local
--   values keep unchanged.
emptyOut :: localsInA -> localsInB -> localsInA
emptyOut fromMaster fromEmbedded = fromMaster  



-- | Looks for all embedded 'Testgraph' in a 'DirGraph',
-- double embedded 'Testgraph' (identified by the attribute 'name')
-- are ignored.
getSubGraphs :: DirGraph a -> [(String, Testgraph a)] -> [(String, Testgraph a)]
getSubGraphs (SimpleDG cp) resList = resList
getSubGraphs (Conc dirGraph1 dirGraph2) resList =
             let newResList1 = getSubGraphs dirGraph1 resList
                 newResList2 = getSubGraphs dirGraph2 newResList1 
             in 
             newResList2
getSubGraphs (Join (Split dirGraphs)) resList = foldr getSubGraphs resList dirGraphs
getSubGraphs (StructDG tg) resList= case (lookup (name (docuInfo tg)) resList) of
                             Nothing -> let newResList = (name (docuInfo tg), tg):resList
                                        in 
                                        getSubGraphs(dirGraph tg) newResList
                             Just _  -> resList