    -- | Pointfree programming fun
    --
    -- A catalogue of refactorings is at:
    --      http://www.cs.kent.ac.uk/projects/refactor-fp/catalogue/
    --      http://www.cs.kent.ac.uk/projects/refactor-fp/catalogue/RefacIdeasAug03.html
    --
    -- Use more Arrow stuff
    --
    -- TODO would be to plug into HaRe and use some of their refactorings.
    module Lambdabot.Plugin.Haskell.Pl (plPlugin) where

    import Lambdabot.Plugin
    import Lambdabot.Util

    import Lambdabot.Plugin.Haskell.Pl.Common          (TopLevel, mapTopLevel, getExpr)
    import Lambdabot.Plugin.Haskell.Pl.Parser          (parsePF)
    import Lambdabot.Plugin.Haskell.Pl.PrettyPrinter   (Expr)
    import Lambdabot.Plugin.Haskell.Pl.Transform       (transform)
    import Lambdabot.Plugin.Haskell.Pl.Optimize        (optimize)

    import Data.IORef
    import System.Timeout

    -- firstTimeout is the timeout when the expression is simplified for the first
    -- time. After each unsuccessful attempt, this number is doubled until it hits
    -- maxTimeout.
    firstTimeout, maxTimeout :: Int
    firstTimeout :: Int
    firstTimeout =  Int
    3000000 --  3 seconds
    maxTimeout :: Int
    maxTimeout   = Int
    15000000 -- 15 seconds

    type PlState = GlobalPrivate () (Int, TopLevel)
    type Pl = ModuleT PlState LB

    plPlugin :: Module (GlobalPrivate () (Int, TopLevel))
    plPlugin :: Module (GlobalPrivate () (Int, TopLevel))
    plPlugin = Module (GlobalPrivate () (Int, TopLevel))
    forall st. Module st
    newModule
        { moduleDefState = return $ mkGlobalPrivate 15 ()

        , moduleCmds = return
            [ (command "pointless")
                { aliases = ["pl"]
                , help = say "pointless <expr>. Play with pointfree code."
                , process = pf
                }
            , (command "pl-resume")
                { help = say "pl-resume. Resume a suspended pointless transformation."
                , process = const res
                }
            ]
        }

    ------------------------------------------------------------------------

    res :: Cmd Pl ()
    res :: Cmd Pl ()
    res = do
      d <- Nick -> Cmd Pl (Maybe (Int, TopLevel))
    forall (m :: * -> *) g p.
    (MonadLBState m, LBState m ~ GlobalPrivate g p) =>
    Nick -> m (Maybe p)
    readPS (Nick -> Cmd Pl (Maybe (Int, TopLevel)))
    -> Cmd Pl Nick -> Cmd Pl (Maybe (Int, TopLevel))
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
    =<< Cmd Pl Nick
    forall (m :: * -> *). Monad m => Cmd m Nick
    getTarget
      case d of
        Just (Int, TopLevel)
    d' -> (Int, TopLevel) -> Cmd Pl ()
    optimizeTopLevel (Int, TopLevel)
    d'
        Maybe (Int, TopLevel)
    Nothing -> String -> Cmd Pl ()
    forall (m :: * -> *). Monad m => String -> Cmd m ()
    say String
    "pointless: sorry, nothing to resume."

    -- | Convert a string to pointfree form
    pf :: String -> Cmd Pl ()
    pf :: String -> Cmd Pl ()
    pf String
    inp = do
        case String -> Either String TopLevel
    parsePF String
    inp of
            Right TopLevel
    d  -> (Int, TopLevel) -> Cmd Pl ()
    optimizeTopLevel (Int
    firstTimeout, (Expr -> Expr) -> TopLevel -> TopLevel
    mapTopLevel Expr -> Expr
    transform TopLevel
    d)
            Left String
    err -> String -> Cmd Pl ()
    forall (m :: * -> *). Monad m => String -> Cmd m ()
    say String
    err

    optimizeTopLevel :: (Int, TopLevel) -> Cmd Pl ()
    optimizeTopLevel :: (Int, TopLevel) -> Cmd Pl ()
    optimizeTopLevel (Int
    to, TopLevel
    d) = do
        target <- Cmd Pl Nick
    forall (m :: * -> *). Monad m => Cmd m Nick
    getTarget
        let (e,decl) = getExpr d
        (e', finished) <- io $ optimizeIO to e
        let eDecl = Expr -> TopLevel
    decl Expr
    e'
        say (show eDecl)
        if finished
            then writePS target Nothing
            else do
                writePS target $ Just (min (2*to) maxTimeout, eDecl)
                say "optimization suspended, use @pl-resume to continue."

    ------------------------------------------------------------------------

    optimizeIO :: Int -> Expr -> IO (Expr, Bool)
    optimizeIO :: Int -> Expr -> IO (Expr, Bool)
    optimizeIO Int
    to Expr
    e = do
      best <- Expr -> IO (IORef Expr)
    forall a. a -> IO (IORef a)
    newIORef Expr
    e
      result <- timeout to (mapM_ (writeIORef best $!) $ optimize e)
      e' <- readIORef best
      return $ case result of
        Maybe ()
    Nothing -> (Expr
    e', Bool
    False)
        Just ()
    _  -> (Expr
    e', Bool
    True)