{-# LANGUAGE DeriveFoldable            #-}
{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE LambdaCase                #-}

module Debug.Tracy
  ( module Debug.Trace
  , tracy
  , keanu
  , arnold
  , hasLength
  , isFound
  , Find
  , FindT )  where


import           Control.Monad.Trans.Maybe
import qualified Data.Foldable             as Fold
import           Debug.Trace               (trace)
import           System.IO.Unsafe          (unsafePerformIO)
import           System.Random             (randomRIO)



delimit :: String -> String -> String
delimit s s' = s ++ " -> " ++ s'

-- | trace with show and a delimiter built in
tracy :: Show a => String -> a -> a
tracy s x = trace (delimit s $ show x) x

-- | Spit out a random Keanu Reaves quote when @a@ is evauluated
keanu :: a -> a
keanu x = trace (delimit "KEANU" . (ks !!) . unsafePerformIO $ randomRIO (0, length ks - 1)) x
  where
   ks = [ "Woah"
        , "I am the one."
        , "Party on"
        , "No way"
        , "Woah"
        , "I know kung fu"
        , "Excellent!"
        , "Huh?"
        , "Whoah.."
        , "All we are is dust in the wind, dude"
        , "Most Triumphant"
        , "Strange things are a foot at the Circle K"
        , "no way"
        , "69 Dudes!"
        , "Those are historic babes!"
        , "Bodacious!"
        , "Fully full on evil robots"
        , "So-crates"
        , "Morpheous"
        , "I'm going to learn jiu jitsu?"
        , "My name is Neo."
        , "No."
        , "take 1 step out and take my hand"
        , "freeze"
        , "id wanna know what bus it was"
        , "bomb on bus"
        , "i need to know can you handle this bus"
        , "the man has no time"
        , "theres a gap in the freeway"
        , "thats all we can do"
        , "floor it"
        , "thats against the rules"
        , "im gonna rip your fucking spine out i swear to god"
        , "pop quiz asshole"
        , "your crazy your fuckin crazy"
        , "he lost his head" ]

-- | spit out a random Arnold Schwarzenegger quote when @a@ is evaluated
arnold :: a -> a
arnold x = trace (delimit "ARNOLD" . (as !!) . unsafePerformIO $ randomRIO (0, length as - 1)) x
  where
  as = [ "It's simple, if it jiggles, it's fat."
       , "Milk is for babies. When you grow up you have to drink beer."
       , "The best activities for your health are pumping and humping."
       , "You're Fiuhed!"
       , "Cookies, who told you you could MY COOKIES!!!!??"
       , "Who is your Daddy, and what does he do?"
       , "I'm detective John Kimble"
       , "Get in the chopper, now!!"
       , "Guwhah ruuugh guawh!"
       , "Grrrgh uu ahhh!"
       , "Naaa gruh aagghh!!!"
       , "Grrruu guaw ghh raaaaaagh!"
       , "IT'S NOT A TUMOR!"
       , "SHAAAD AAAAAAAAAAAAAAAP!"
       , "I let him go.."
       , "He had to split"
       , "Remember Sully when I said I'd kill you last? I lied."
       , "You are not sending me to the coolah..."
       , "Stop CHEEERING ME UP!"
       , "You are one ugly motherfucker..."
       , "Do it."
       , "I'll be back."
       , "Foget it, I'm nut goiing to sit on yo lap" ]

-- | Inspect if @t a@ is null
isFound :: Foldable t => String -> t a -> t a
isFound s x = trace  (delimit s $ "was" ++ (if Fold.null x then " NOT" else "") ++ " found") x

-- | Inspect if @t a@ contains @a@
isElem :: (Foldable t, Eq a, Show a) => String -> a -> t a -> t a
isElem s x t = let s' = show x in trace (delimit s $
             if Fold.elem x t then "contains " ++ s' else "does NOT contain " ++ s') t

-- | Inspect if @Bool@ is legit
isTrue :: String -> Bool -> Bool
isTrue s x = trace (delimit s $ if x then "is legit" else "is buillshit") x

-- | Inspect the size of a collection
hasLength :: Foldable t => String -> t a -> t a
hasLength s f = trace (delimit s $ "has length " ++ show (Fold.length f)) f


-- | Wrapper for inspecting a usage of the Maybe Monad
data Find a = Find String (Maybe a)
  deriving (Show, Eq, Ord, Foldable)

instance Functor Find where
  fmap f (Find s x) = Find s $ f <$> isFound s x

instance Applicative Find where
  pure = Find "pure" . pure
  Find _ mf <*> Find s x = Find s $ mf <*> isFound s x

instance Monad Find where
  Find s x >>= f = case isFound s x of
    Just x' -> f x'
    _       -> Find s Nothing

-- | Wrapper for inspecting a usage of the MaybeT Monad Transformer
data FindT m a = FindT String (MaybeT m a)

runFindT (FindT _ x) = x

instance Monad m => Functor (FindT m) where
  fmap f (FindT s x) = FindT s . MaybeT $ fmap f . isFound s <$> runMaybeT x

instance Monad m => Applicative (FindT m) where
  pure = FindT "pure" . pure
  FindT _ mf <*> FindT s x = FindT s $ mf <*> MaybeT (isFound s <$> runMaybeT x)

instance Monad m => Monad (FindT m) where
  FindT s x >>= f = FindT s $ MaybeT $ do
    y <- runMaybeT x
    case isFound s y of
      Just x' -> runMaybeT $ runFindT (f x')
      _       -> return Nothing