import Data.Map (Map)
import qualified Data.Map as Map
import Control.Applicative (liftA2)
import Data.Set (Set)
import qualified Data.Set as Set
import Control.Monad
import Control.Monad.State
import Control.Lens

loudNeg :: Int -> ([String], Int)
loudNeg n = (["neg " ++ show n], negate n)

loudPlus, loudMinus :: Int -> Int -> ([String], Int)
loudPlus n m = ([show n ++ " + " ++ show m], n + m)
loudMinus n m = loudNeg m >>= loudPlus n

loudTimes :: Int -> Int -> ([String], Int)
loudTimes 0 _ = pure 0
loudTimes n m
    | n > 0 = do n' <- loudMinus n 1
                 m' <- loudTimes n' m
                 loudPlus m' m
    | n < 0 = loudNeg n >>= flip loudTimes m >>= loudNeg





-- ---------------------------------------------------------------------------
data Formula = Var String
             | And Formula Formula
             | Or  Formula Formula
             | Not Formula
             deriving (Eq, Ord, Show)

type Valuation = Map String Bool
eval :: Formula -> (Valuation -> Bool)
eval (Var v)   = Map.findWithDefault False v
eval (And x y) = do lhs <- eval x
                    if not lhs then pure False
                               else eval y
eval (Or  x y) = liftA2 (||) (eval x) (eval y)
eval (Not x)   = not <$> eval x





-- ---------------------------------------------------------------------------
type Vertex = Char
type Edge = (Vertex, Vertex)
type Stamp = (Vertex, Int, Int)

dfs :: Vertex -> [Edge] -> State (Int, Set Vertex) [Stamp]
dfs v es = do
    _2 %= Set.insert v
    tDisc <- gets fst
    _1 += 1
    let succs = snd <$> filter ((== v).fst) es
    succStamps <- forM succs $ \s -> do
        visited <- gets snd
        if s `elem` visited then return []
                            else dfs s es
    tFin <- gets fst
    _1 += 1
    return $ (v, tDisc, tFin) : concat succStamps

dfs' :: Vertex -> [Edge] -> [Stamp]
dfs' v es = evalState (dfs v es) (1, Set.empty)

g :: [Edge]
g = [ ('a','b')
    , ('a','c')
    , ('a','d')
    , ('b','c')
    , ('b','e')
    , ('c','b')
    , ('c','d')
    , ('c','c')
    , ('d','a')
    , ('e','b')
    ]