-- | -- Module: Acme.Inator -- License: Public Domain -- Maintainer: Mark Lentczner -- Stability: unstable, may self-destruct -- Portability: portable -- -- Construction and operation of evil inventions in the Tri-State area. -- Based on the pioneering work of Dr. Heinz Doofenschmirtz. module Acme.Inator ( -- * Evil Inventions EvilInvention, inator, selfDestruct, -- * Secret Agents Agent(..), perryThePlatypus, TrappedAgent, -- * The TriStateArea TriStateArea, activate, whileTrapping, ) where import Control.Monad (liftM) -- | An 'EvilInvention' is like a normal function @a -> b@, only used in evil -- plans. It will only function in the context of a 'TrappedAgent'. See -- 'activate' for how to turn one one. type EvilInvention a b = (TrappedAgent, a) -> b -- | Combinator to turn a function into an 'EvilInvention'. Typically applied -- via the '.' operator, like so: -- -- > incrementinator :: EvilInvention Int Int -- > incrementinator = (+1) . inator inator :: (TrappedAgent, a) -> a inator = snd -- | /Warning:/ All 'EvilInvention's have a 'selfDestruct' ability. When an -- 'EvilInvention' self-destructs, all effects of evil plans in the -- 'TriStateArea' are nullified, as if 'Nothing' ever happened. selfDestruct :: EvilInvention a b -> TriStateArea () selfDestruct _ = fail "Kaboom!" -- | Agents are secret, and distinguished only by their letter designations. data Agent = Agent Char deriving (Eq, Ord, Bounded, Read, Show) -- | 'Agent' @\'P\'@ perryThePlatypus :: Agent perryThePlatypus = Agent 'P' -- | When trapped, an 'Agent' enables an 'EvilInvention' to be 'activate'd and -- then used. The scope of trapping an 'Agent' is strictly delimited. -- See 'whileTrapping'. data TrappedAgent = TrappedAgent Agent -- | Activation and operation of an 'EvilInvention' is strictly limited to the -- 'TriStateArea'. Plans executed in the 'TriStateArea' may 'fail', causing the -- whole plan to have no externally visible effect. data TriStateArea a = TriStateArea { takeOver :: TrappedAgent -> Maybe a } instance Functor TriStateArea where fmap = liftM instance Monad TriStateArea where return = TriStateArea . const . Just f >>= g = TriStateArea (\ta -> takeOver f ta >>= flip takeOver ta . g) fail _ = TriStateArea $ const Nothing -- | The 'Agent' trapped in the 'TriStateArea'. trappedAgent :: TriStateArea TrappedAgent trappedAgent = TriStateArea Just -- | 'EvilInvention's must be activated before use. The activated machine can -- then be applied to suitable targets of scorn and dislike. /N.B.:/ Activation -- and subsequent operation of an 'EvilInvention' can only be performed in the -- 'TriStateArea'. -- -- > evilPlan :: TriStateArea Int -- > evilPlan = do -- > zap <- activate incrementinator -- > as <- mapM zap [1..37] -- > b <- zap 38 -- I never really liked the number 38 -- > selfDestruct incrementinator -- > cs <- mapM zap [39..100] -- > return $ sum as + b + sum cs activate :: EvilInvention a b -> TriStateArea (a -> TriStateArea b) activate contraption = return $ \a -> do ta <- trappedAgent return $ contraption (ta,a) -- | To execute any plan (evil or 'otherwise') in the 'TriStateArea', an -- 'Agent' must be trapped with this function, and held for the duration of -- of the plan. -- -- > executeEvilPlan = whileTrapping perryThePlatypus evilPlan -- > -- > main :: IO () -- > main = do -- > putStrLn $ -- > case executeEvilPlan of -- > Nothing -> "Curse you, Perry the Platypus!" -- > Just a -> "Ha ha! I have incremented the TriStateArea to " ++ show a whileTrapping :: Agent -> TriStateArea a -> Maybe a whileTrapping a f = takeOver f $ TrappedAgent a