{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ViewPatterns #-}
{-# LANGUAGE NumDecimals #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE ApplicativeDo #-}
{-# LANGUAGE Arrows #-}

module Main where

import Prelude hiding ((.),id)
import Data.Monoid
import Data.Foldable
import Data.Tree
import Data.Functor.Const

import Control.Category
import Control.Arrow
import Control.Monad
import Control.Monad.Trans.Writer
import Control.Monad.Trans.State
import Control.Comonad

import Control.Plan
import Control.Plan.Core

import Test.Tasty
import Test.Tasty.HUnit (testCase,assertEqual,assertBool)

import Streaming
import qualified Streaming.Prelude

main :: IO ()
main = defaultMain tests

tests :: TestTree
tests = testGroup "Tests" [testCase "simple" testSimple
                          ,testCase "multi" testMulti
                          ,testCase "pathsMulti" testPathsMulti
                          ,testCase "runMulti" testRunMulti
                          ,testCase "skippy" testSkippy
                          ,testCase "runSkippy" testRunSkippy
                          ]

testSimple :: IO ()
testSimple = do
    let plan' = pure 7 :: Plan Char () IO () Int
    assertEqual "" []
                   (bifoldMap pure (const []) (getSteps plan')) 

multi :: Plan String [Int] (Writer [String]) () ()
multi = do
    _ <- step "a" (do _ <- step "a1" (foretell [1] *> plan (tell ["a1"]) <* foretell [2])
                      _ <- step "a2" (foretell [3] *> plan (tell ["a2"]) <* foretell [4])
                      return ())
    _ <- step "b" (do _ <- step "b1" (foretell [5] *> plan (tell ["b1"]) <* foretell [6])
                      _ <- step "b2" (foretell [7] *> plan (tell ["b2"]) <* foretell [8])
                      return ())
    return ()

testMulti :: IO ()
testMulti = assertEqual "" [Left "a"
                           ,Left "a1"
                           ,Right 1
                           ,Right 2
                           ,Left "a2"
                           ,Right 3
                           ,Right 4
                           ,Left "b"
                           ,Left "b1"
                           ,Right 5
                           ,Right 6
                           ,Left "b2"
                           ,Right 7
                           ,Right 8
                           ]
                           (bifoldMap (pure . Left) (map Right) . getSteps $ multi)

testPathsMulti :: IO ()
testPathsMulti = assertEqual "" ["a","a1","a2","b","b1","b2"]
                                (map toList . bifoldMap pure (const []) . getSteps $ multi)

progressToTick' :: Progress s t -> Tick' 
progressToTick' (Skipped {}) = Skipped'
progressToTick' (Started {}) = Started'
progressToTick' (Finished {}) = Finished'

testRunMulti :: IO ()
testRunMulti = do
      let multi' = hoistPlan lift multi 
          addToCounter = modify' succ >> get
          ((ticks :> (timeline,_),_),results) = runWriter 
                                              . flip runStateT 'a'
                                              . Streaming.Prelude.toList 
                                              . runPlan addToCounter $ multi' 
      assertEqual "timeline" [Node (Right ('b','g'),"a") [Node (Right ('c','d'),"a1") []
                                                         ,Node (Right ('e','f'),"a2") []]
                             ,Node (Right ('h','m'),"b") [Node (Right ('i','j'),"b1") []
                                                         ,Node (Right ('k','l'),"b2") []]]
                             (toForest (instants timeline))
      assertEqual "timelineEnd" 'n' 
                                (extract timeline)
      assertEqual "ticksLen" 12 
                            (length ticks) 
      let simpleTicks = map (\(Tick ctxs progress) -> (toList . fmap (extract.completed) $ ctxs
                                                      ,toList . fmap current $ ctxs
                                                      ,progressToTick' progress)) 
                            ticks
      assertEqual "tickTypes" [("b" ,["a"],Started')
                              ,("cb",["a1","a"],Started')
                              ,("cb",["a1","a"],Finished')
                              ,("eb",["a2","a"],Started')
                              ,("eb",["a2","a"],Finished')
                              ,("b" ,["a"],Finished')
                              ,("h" ,["b"],Started')
                              ,("ih",["b1","b"],Started')
                              ,("ih",["b1","b"],Finished')
                              ,("kh",["b2","b"],Started')
                              ,("kh",["b2","b"],Finished')
                              ,("h" ,["b"],Finished')
                              ]
                              simpleTicks
      assertBool "" $ all (\tick -> bifoldMap id (const mempty) tick
                                    ==
                                    foldMap (foldMap id) (toForest tick))
                          ticks
      assertBool "" $ all (\tick -> (getConst (bitraverse (\s -> Const s) (\t -> Const mempty) tick))
                                    ==
                                    foldMap (foldMap id) (toForest tick))
                          ticks
      let forestTicks = take 3 . map (toForest . completedness) $ ticks
      assertEqual "tickForests" [[Node (Just (Right ('b',Nothing)),"a") [Node (Nothing,"a1") []
                                                                        ,Node (Nothing,"a2") []]
                                 ,Node (Nothing,"b") [Node (Nothing,"b1") []
                                                     ,Node (Nothing,"b2") []]]
                                ,[Node (Just (Right ('b',Nothing)),"a") [Node (Just (Right ('c',Nothing)),"a1") []
                                                                        ,Node (Nothing,"a2") []]
                                 ,Node (Nothing,"b") [Node (Nothing,"b1") []
                                                     ,Node (Nothing,"b2") []]]

                                ,[Node (Just (Right ('b',Nothing)),"a") [Node (Just (Right ('c',Just 'd')),"a1") []
                                                                        ,Node (Nothing,"a2") []]
                                 ,Node (Nothing,"b") [Node (Nothing,"b1") []
                                                     ,Node (Nothing,"b2") []]]]
                                forestTicks

skippy :: Plan String [Int] (Writer [String]) () ()
skippy = step "a" (plan (return (Just ())))
         >>>
         skippable "sa" (plan (tell ["sa"]))
         >>>
         step "b" (plan (return Nothing))
         >>>
         skippable "sb" (plan (tell ["sb"]))

testSkippy :: IO ()
testSkippy = assertEqual "" [Left (Mandatory,"a")
                            ,Left (Skippable,"sa")
                            ,Left (Mandatory,"b")
                            ,Left (Skippable,"sb")
                            ]
                            (bifoldMap (pure . Left) (map Right) . mandatoriness . getSteps $ skippy)

testRunSkippy :: IO ()
testRunSkippy = do
      let skippy' = hoistPlan lift skippy
          addToCounter = modify' succ >> get
          ((ticks :> (timeline,_),_),results) = runWriter 
                                              . flip runStateT 'a'
                                              . Streaming.Prelude.toList 
                                              . runPlan addToCounter $ skippy' 
      assertEqual "timeline" [Node (Right ('b','c'),"a") []
                             ,Node (Right ('d','e'),"sa") []
                             ,Node (Right ('f','g'),"b") []
                             ,Node (Left 'h',"sb") []
                             ]
                             (toForest (instants timeline))
      assertEqual "timelineEnd" 'i' 
                                (extract timeline)
      assertEqual "ticksLen" 7
                             (length ticks) 
      let simpleTicks = map (\(Tick ctxs progress) -> (toList . fmap (extract.completed) $ ctxs
                                                      ,toList . fmap current $ ctxs
                                                      ,progressToTick' progress)) 
                            ticks
      assertEqual "tickTypes" [("b",["a"],Started')
                              ,("b",["a"],Finished')
                              ,("d",["sa"],Started')
                              ,("d",["sa"],Finished')
                              ,("f",["b"],Started')
                              ,("f",["b"],Finished')
                              ,("h",["sb"],Skipped')]
                              simpleTicks
      let forestTicks = take 1 . map (toForest . completedness) $ ticks
      assertEqual "tickForests" [[Node (Just (Right ('b',Nothing)),"a") []
                                 ,Node (Nothing,"sa") []
                                 ,Node (Nothing,"b") []
                                 ,Node (Nothing,"sb") []]]
                                forestTicks