{-# LANGUAGE DeriveFoldable #-} {-# LANGUAGE ExistentialQuantification #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE KindSignatures #-} {-# LANGUAGE LambdaCase #-} module Debug.Tracy ( module Debug.Trace , tracy , proTracy , keanu , arnold , hasLength , isFound , spy , scope , unScope , Scope ) where import Control.Monad.Trans.Class import Control.Monad.Trans.Maybe import qualified Data.Foldable as Fold import Debug.Trace (trace) import System.IO.Unsafe (unsafePerformIO) import System.Random (randomRIO) spy :: Show b => String -> (a -> b) -> a -> a spy m f x = trace (delimit m $ show (f x)) x delimit :: String -> String -> String delimit s s' = s ++ "\t-> " ++ s' -- | trace with show and a delimiter built in tracy :: Show a => String -> a -> a tracy s x = trace (delimit s $ show x) x -- | trace the input and output of a function proTracy :: (Show a, Show b) => String -> (a -> b) -> a -> b proTracy msg f = tracy (msg ++ " post") . f . tracy (msg ++ " pre") -- | 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 data Scope f a = Scope String (f a) unScope :: Scope f a -> f a unScope (Scope _ x) = x scope :: String -> f a -> Scope f a scope = Scope instance (Functor f, Foldable f) => Functor (Scope f) where fmap f (Scope m x) = Scope m $ f <$> (isFound m x) instance (Applicative f, Foldable f) => Applicative (Scope f) where pure x = Scope "pure" $ pure x Scope fm fx <*> Scope m x = Scope m $ isFound fm fx <*> isFound m x instance (Monad m, Foldable m) => Monad (Scope m) where Scope m x >>= f = Scope m $ isFound m x >>= unScope . f return x = Scope "return" $ return x