acme-inator-0.1.0.0: Acme/Inator.hs

-- |
-- Module:      Acme.Inator
-- License:     Public Domain
-- Maintainer:  Mark Lentczner <mzero@glyphic.com>
-- 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