    #if __GLASGOW_HASKELL__ < 802
    {-# OPTIONS_GHC -Wno-redundant-constraints #-}
    #endif
    module System.Console.Haskeline.Backend.Terminfo(
                                Draw(),
                                runTerminfoDraw
                                )
                                 where

    import System.Console.Terminfo
    import Control.Monad
    import Control.Monad.Catch
    import Data.List(foldl')
    import System.IO
    import qualified Control.Exception as Exception
    import Data.Maybe (fromMaybe, mapMaybe)
    import qualified Data.IntMap as Map

    import System.Console.Haskeline.Monads as Monads
    import System.Console.Haskeline.LineState
    import System.Console.Haskeline.Term
    import System.Console.Haskeline.Backend.Posix
    import System.Console.Haskeline.Backend.WCWidth
    import System.Console.Haskeline.Key

    import qualified Control.Monad.Trans.Writer as Writer

    ----------------------------------------------------------------
    -- Low-level terminal output

    -- | Keep track of all of the output capabilities we can use.
    --
    -- We'll be frequently using the (automatic) 'Monoid' instance for
    -- @Actions -> TermOutput@.
    data Actions = Actions {Actions -> Int -> TermOutput
    leftA, Actions -> Int -> TermOutput
    rightA, Actions -> Int -> TermOutput
    upA :: Int -> TermOutput,
                            TermAction
    clearToLineEnd :: TermOutput,
                            TermAction
    nl, TermAction
    cr :: TermOutput,
                            TermAction
    bellAudible,TermAction
    bellVisual :: TermOutput,
                            Actions -> Int -> TermOutput
    clearAllA :: LinesAffected -> TermOutput,
                            TermAction
    wrapLine :: TermOutput}

    getActions :: Capability Actions
    getActions :: Capability Actions
    getActions = do
        -- This capability is not strictly necessary, but is very widely supported
        -- and assuming it makes for a much simpler implementation of printText.
        Capability Bool
    autoRightMargin Capability Bool -> (Bool -> Capability ()) -> Capability ()
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= Bool -> Capability ()
    forall (f :: * -> *). Alternative f => Bool -> f ()
    guard

        Int -> TermOutput
    leftA' <- Capability (Int -> TermOutput)
    forall s. TermStr s => Capability (Int -> s)
    moveLeft
        Int -> TermOutput
    rightA' <- Capability (Int -> TermOutput)
    forall s. TermStr s => Capability (Int -> s)
    moveRight
        Int -> TermOutput
    upA' <- Capability (Int -> TermOutput)
    forall s. TermStr s => Capability (Int -> s)
    moveUp
        TermOutput
    clearToLineEnd' <- Capability TermOutput
    forall s. TermStr s => Capability s
    clearEOL
        Int -> TermOutput
    clearAll' <- Capability (Int -> TermOutput)
    clearScreen
        TermOutput
    nl' <- Capability TermOutput
    forall s. TermStr s => Capability s
    newline
        TermOutput
    cr' <- Capability TermOutput
    forall s. TermStr s => Capability s
    carriageReturn
        -- Don't require the bell capabilities
        TermOutput
    bellAudible' <- Capability TermOutput
    forall s. TermStr s => Capability s
    bell Capability TermOutput
    -> Capability TermOutput -> Capability TermOutput
    forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
    `mplus` TermOutput -> Capability TermOutput
    forall (m :: * -> *) a. Monad m => a -> m a
    return TermOutput
    forall a. Monoid a => a
    mempty
        TermOutput
    bellVisual' <- Capability TermOutput
    visualBell Capability TermOutput
    -> Capability TermOutput -> Capability TermOutput
    forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
    `mplus` TermOutput -> Capability TermOutput
    forall (m :: * -> *) a. Monad m => a -> m a
    return TermOutput
    forall a. Monoid a => a
    mempty
        TermOutput
    wrapLine' <- TermOutput -> Capability TermOutput
    getWrapLine (Int -> TermOutput
    leftA' Int
    1)
        Actions -> Capability Actions
    forall (m :: * -> *) a. Monad m => a -> m a
    return Actions :: (Int -> TermOutput)
    -> (Int -> TermOutput)
    -> (Int -> TermOutput)
    -> TermOutput
    -> TermOutput
    -> TermOutput
    -> TermOutput
    -> TermOutput
    -> (Int -> TermOutput)
    -> TermOutput
    -> Actions
    Actions{leftA :: Int -> TermOutput
    leftA = Int -> TermOutput
    leftA', rightA :: Int -> TermOutput
    rightA = Int -> TermOutput
    rightA',upA :: Int -> TermOutput
    upA = Int -> TermOutput
    upA',
                    clearToLineEnd :: TermOutput
    clearToLineEnd = TermOutput
    clearToLineEnd', nl :: TermOutput
    nl = TermOutput
    nl',cr :: TermOutput
    cr = TermOutput
    cr',
                    bellAudible :: TermOutput
    bellAudible = TermOutput
    bellAudible', bellVisual :: TermOutput
    bellVisual = TermOutput
    bellVisual',
                    clearAllA :: Int -> TermOutput
    clearAllA = Int -> TermOutput
    clearAll',
                     wrapLine :: TermOutput
    wrapLine = TermOutput
    wrapLine'}

    -- If the wraparound glitch is in effect, force a wrap by printing a space.
    -- Otherwise, it'll wrap automatically.
    getWrapLine :: TermOutput -> Capability TermOutput
    getWrapLine :: TermOutput -> Capability TermOutput
    getWrapLine TermOutput
    left1 = (do
        Capability Bool
    wraparoundGlitch Capability Bool -> (Bool -> Capability ()) -> Capability ()
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= Bool -> Capability ()
    forall (f :: * -> *). Alternative f => Bool -> f ()
    guard
        TermOutput -> Capability TermOutput
    forall (m :: * -> *) a. Monad m => a -> m a
    return (String -> TermOutput
    termText String
    " " TermOutput -> TermOutput -> TermOutput
    forall m. Monoid m => m -> m -> m
    <#> TermOutput
    left1)
        ) Capability TermOutput
    -> Capability TermOutput -> Capability TermOutput
    forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
    `mplus` TermOutput -> Capability TermOutput
    forall (m :: * -> *) a. Monad m => a -> m a
    return TermOutput
    forall a. Monoid a => a
    mempty

    ----------------------------------------------------------------
    -- The Draw monad

    -- denote in modular arithmetic;
    -- in particular, 0 <= termCol < width
    data TermPos = TermPos {TermPos -> Int
    termRow,TermPos -> Int
    termCol :: !Int}
        deriving Int -> TermPos -> ShowS
    [TermPos] -> ShowS
    TermPos -> String
    (Int -> TermPos -> ShowS)
    -> (TermPos -> String) -> ([TermPos] -> ShowS) -> Show TermPos
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    showList :: [TermPos] -> ShowS
    $cshowList :: [TermPos] -> ShowS
    show :: TermPos -> String
    $cshow :: TermPos -> String
    showsPrec :: Int -> TermPos -> ShowS
    $cshowsPrec :: Int -> TermPos -> ShowS
    Show

    initTermPos :: TermPos
    initTermPos :: TermPos
    initTermPos = TermPos :: Int -> Int -> TermPos
    TermPos {termRow :: Int
    termRow = Int
    0, termCol :: Int
    termCol = Int
    0}

    data TermRows = TermRows {
                        TermRows -> IntMap Int
    rowLengths :: !(Map.IntMap Int),
                        -- ^ The length of each nonempty row
                        TermRows -> Int
    lastRow :: !Int
                        -- ^ The last nonempty row, or zero if the entire line
                        -- is empty.  Note that when the cursor wraps to the first
                        -- column of the next line, termRow > lastRow.
                             }
        deriving Int -> TermRows -> ShowS
    [TermRows] -> ShowS
    TermRows -> String
    (Int -> TermRows -> ShowS)
    -> (TermRows -> String) -> ([TermRows] -> ShowS) -> Show TermRows
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    showList :: [TermRows] -> ShowS
    $cshowList :: [TermRows] -> ShowS
    show :: TermRows -> String
    $cshow :: TermRows -> String
    showsPrec :: Int -> TermRows -> ShowS
    $cshowsPrec :: Int -> TermRows -> ShowS
    Show

    initTermRows :: TermRows
    initTermRows :: TermRows
    initTermRows = TermRows :: IntMap Int -> Int -> TermRows
    TermRows {rowLengths :: IntMap Int
    rowLengths = IntMap Int
    forall a. IntMap a
    Map.empty, lastRow :: Int
    lastRow=Int
    0}

    setRow :: Int -> Int -> TermRows -> TermRows
    setRow :: Int -> Int -> TermRows -> TermRows
    setRow Int
    r Int
    len TermRows
    rs = TermRows :: IntMap Int -> Int -> TermRows
    TermRows {rowLengths :: IntMap Int
    rowLengths = Int -> Int -> IntMap Int -> IntMap Int
    forall a. Int -> a -> IntMap a -> IntMap a
    Map.insert Int
    r Int
    len (TermRows -> IntMap Int
    rowLengths TermRows
    rs),
                                lastRow :: Int
    lastRow=Int
    r}

    lookupCells :: TermRows -> Int -> Int
    lookupCells :: TermRows -> Int -> Int
    lookupCells (TermRows IntMap Int
    rc Int
    _) Int
    r = Int -> Int -> IntMap Int -> Int
    forall a. a -> Int -> IntMap a -> a
    Map.findWithDefault Int
    0 Int
    r IntMap Int
    rc

    newtype Draw m a = Draw {forall (m :: * -> *) a.
    Draw m a
    -> ReaderT
         Actions
         (ReaderT Terminal (StateT TermRows (StateT TermPos (PosixT m))))
         a
    unDraw :: (ReaderT Actions
                                        (ReaderT Terminal
                                        (StateT TermRows
                                        (StateT TermPos
                                        (PosixT m))))) a}
        deriving ((forall a b. (a -> b) -> Draw m a -> Draw m b)
    -> (forall a b. a -> Draw m b -> Draw m a) -> Functor (Draw m)
    forall a b. a -> Draw m b -> Draw m a
    forall a b. (a -> b) -> Draw m a -> Draw m b
    forall (m :: * -> *) a b. Functor m => a -> Draw m b -> Draw m a
    forall (m :: * -> *) a b.
    Functor m =>
    (a -> b) -> Draw m a -> Draw m b
    forall (f :: * -> *).
    (forall a b. (a -> b) -> f a -> f b)
    -> (forall a b. a -> f b -> f a) -> Functor f
    <$ :: forall a b. a -> Draw m b -> Draw m a
    $c<$ :: forall (m :: * -> *) a b. Functor m => a -> Draw m b -> Draw m a
    fmap :: forall a b. (a -> b) -> Draw m a -> Draw m b
    $cfmap :: forall (m :: * -> *) a b.
    Functor m =>
    (a -> b) -> Draw m a -> Draw m b
    Functor, Functor (Draw m)
    Functor (Draw m)
    -> (forall a. a -> Draw m a)
    -> (forall a b. Draw m (a -> b) -> Draw m a -> Draw m b)
    -> (forall a b c.
        (a -> b -> c) -> Draw m a -> Draw m b -> Draw m c)
    -> (forall a b. Draw m a -> Draw m b -> Draw m b)
    -> (forall a b. Draw m a -> Draw m b -> Draw m a)
    -> Applicative (Draw m)
    forall a. a -> Draw m a
    forall a b. Draw m a -> Draw m b -> Draw m a
    forall a b. Draw m a -> Draw m b -> Draw m b
    forall a b. Draw m (a -> b) -> Draw m a -> Draw m b
    forall a b c. (a -> b -> c) -> Draw m a -> Draw m b -> Draw m c
    forall {m :: * -> *}. Monad m => Functor (Draw m)
    forall (m :: * -> *) a. Monad m => a -> Draw m a
    forall (m :: * -> *) a b.
    Monad m =>
    Draw m a -> Draw m b -> Draw m a
    forall (m :: * -> *) a b.
    Monad m =>
    Draw m a -> Draw m b -> Draw m b
    forall (m :: * -> *) a b.
    Monad m =>
    Draw m (a -> b) -> Draw m a -> Draw m b
    forall (m :: * -> *) a b c.
    Monad m =>
    (a -> b -> c) -> Draw m a -> Draw m b -> Draw m c
    forall (f :: * -> *).
    Functor f
    -> (forall a. a -> f a)
    -> (forall a b. f (a -> b) -> f a -> f b)
    -> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
    -> (forall a b. f a -> f b -> f b)
    -> (forall a b. f a -> f b -> f a)
    -> Applicative f
    <* :: forall a b. Draw m a -> Draw m b -> Draw m a
    $c<* :: forall (m :: * -> *) a b.
    Monad m =>
    Draw m a -> Draw m b -> Draw m a
    *> :: forall a b. Draw m a -> Draw m b -> Draw m b
    $c*> :: forall (m :: * -> *) a b.
    Monad m =>
    Draw m a -> Draw m b -> Draw m b
    liftA2 :: forall a b c. (a -> b -> c) -> Draw m a -> Draw m b -> Draw m c
    $cliftA2 :: forall (m :: * -> *) a b c.
    Monad m =>
    (a -> b -> c) -> Draw m a -> Draw m b -> Draw m c
    <*> :: forall a b. Draw m (a -> b) -> Draw m a -> Draw m b
    $c<*> :: forall (m :: * -> *) a b.
    Monad m =>
    Draw m (a -> b) -> Draw m a -> Draw m b
    pure :: forall a. a -> Draw m a
    $cpure :: forall (m :: * -> *) a. Monad m => a -> Draw m a
    Applicative, Applicative (Draw m)
    Applicative (Draw m)
    -> (forall a b. Draw m a -> (a -> Draw m b) -> Draw m b)
    -> (forall a b. Draw m a -> Draw m b -> Draw m b)
    -> (forall a. a -> Draw m a)
    -> Monad (Draw m)
    forall a. a -> Draw m a
    forall a b. Draw m a -> Draw m b -> Draw m b
    forall a b. Draw m a -> (a -> Draw m b) -> Draw m b
    forall (m :: * -> *). Monad m => Applicative (Draw m)
    forall (m :: * -> *) a. Monad m => a -> Draw m a
    forall (m :: * -> *) a b.
    Monad m =>
    Draw m a -> Draw m b -> Draw m b
    forall (m :: * -> *) a b.
    Monad m =>
    Draw m a -> (a -> Draw m b) -> Draw m b
    forall (m :: * -> *).
    Applicative m
    -> (forall a b. m a -> (a -> m b) -> m b)
    -> (forall a b. m a -> m b -> m b)
    -> (forall a. a -> m a)
    -> Monad m
    return :: forall a. a -> Draw m a
    $creturn :: forall (m :: * -> *) a. Monad m => a -> Draw m a
    >> :: forall a b. Draw m a -> Draw m b -> Draw m b
    $c>> :: forall (m :: * -> *) a b.
    Monad m =>
    Draw m a -> Draw m b -> Draw m b
    >>= :: forall a b. Draw m a -> (a -> Draw m b) -> Draw m b
    $c>>= :: forall (m :: * -> *) a b.
    Monad m =>
    Draw m a -> (a -> Draw m b) -> Draw m b
    Monad, Monad (Draw m)
    Monad (Draw m) -> (forall a. IO a -> Draw m a) -> MonadIO (Draw m)
    forall a. IO a -> Draw m a
    forall (m :: * -> *).
    Monad m -> (forall a. IO a -> m a) -> MonadIO m
    forall {m :: * -> *}. MonadIO m => Monad (Draw m)
    forall (m :: * -> *) a. MonadIO m => IO a -> Draw m a
    liftIO :: forall a. IO a -> Draw m a
    $cliftIO :: forall (m :: * -> *) a. MonadIO m => IO a -> Draw m a
    MonadIO,
                  MonadCatch (Draw m)
    MonadCatch (Draw m)
    -> (forall b.
        ((forall a. Draw m a -> Draw m a) -> Draw m b) -> Draw m b)
    -> (forall b.
        ((forall a. Draw m a -> Draw m a) -> Draw m b) -> Draw m b)
    -> (forall a b c.
        Draw m a
        -> (a -> ExitCase b -> Draw m c)
        -> (a -> Draw m b)
        -> Draw m (b, c))
    -> MonadMask (Draw m)
    forall b.
    ((forall a. Draw m a -> Draw m a) -> Draw m b) -> Draw m b
    forall a b c.
    Draw m a
    -> (a -> ExitCase b -> Draw m c)
    -> (a -> Draw m b)
    -> Draw m (b, c)
    forall {m :: * -> *}. MonadMask m => MonadCatch (Draw m)
    forall (m :: * -> *) b.
    MonadMask m =>
    ((forall a. Draw m a -> Draw m a) -> Draw m b) -> Draw m b
    forall (m :: * -> *) a b c.
    MonadMask m =>
    Draw m a
    -> (a -> ExitCase b -> Draw m c)
    -> (a -> Draw m b)
    -> Draw m (b, c)
    forall (m :: * -> *).
    MonadCatch m
    -> (forall b. ((forall a. m a -> m a) -> m b) -> m b)
    -> (forall b. ((forall a. m a -> m a) -> m b) -> m b)
    -> (forall a b c.
        m a -> (a -> ExitCase b -> m c) -> (a -> m b) -> m (b, c))
    -> MonadMask m
    generalBracket :: forall a b c.
    Draw m a
    -> (a -> ExitCase b -> Draw m c)
    -> (a -> Draw m b)
    -> Draw m (b, c)
    $cgeneralBracket :: forall (m :: * -> *) a b c.
    MonadMask m =>
    Draw m a
    -> (a -> ExitCase b -> Draw m c)
    -> (a -> Draw m b)
    -> Draw m (b, c)
    uninterruptibleMask :: forall b.
    ((forall a. Draw m a -> Draw m a) -> Draw m b) -> Draw m b
    $cuninterruptibleMask :: forall (m :: * -> *) b.
    MonadMask m =>
    ((forall a. Draw m a -> Draw m a) -> Draw m b) -> Draw m b
    mask :: forall b.
    ((forall a. Draw m a -> Draw m a) -> Draw m b) -> Draw m b
    $cmask :: forall (m :: * -> *) b.
    MonadMask m =>
    ((forall a. Draw m a -> Draw m a) -> Draw m b) -> Draw m b
    MonadMask, Monad (Draw m)
    Monad (Draw m)
    -> (forall e a. Exception e => e -> Draw m a)
    -> MonadThrow (Draw m)
    forall e a. Exception e => e -> Draw m a
    forall (m :: * -> *).
    Monad m -> (forall e a. Exception e => e -> m a) -> MonadThrow m
    forall {m :: * -> *}. MonadThrow m => Monad (Draw m)
    forall (m :: * -> *) e a.
    (MonadThrow m, Exception e) =>
    e -> Draw m a
    throwM :: forall e a. Exception e => e -> Draw m a
    $cthrowM :: forall (m :: * -> *) e a.
    (MonadThrow m, Exception e) =>
    e -> Draw m a
    MonadThrow, MonadThrow (Draw m)
    MonadThrow (Draw m)
    -> (forall e a.
        Exception e =>
        Draw m a -> (e -> Draw m a) -> Draw m a)
    -> MonadCatch (Draw m)
    forall e a. Exception e => Draw m a -> (e -> Draw m a) -> Draw m a
    forall (m :: * -> *).
    MonadThrow m
    -> (forall e a. Exception e => m a -> (e -> m a) -> m a)
    -> MonadCatch m
    forall {m :: * -> *}. MonadCatch m => MonadThrow (Draw m)
    forall (m :: * -> *) e a.
    (MonadCatch m, Exception e) =>
    Draw m a -> (e -> Draw m a) -> Draw m a
    catch :: forall e a. Exception e => Draw m a -> (e -> Draw m a) -> Draw m a
    $ccatch :: forall (m :: * -> *) e a.
    (MonadCatch m, Exception e) =>
    Draw m a -> (e -> Draw m a) -> Draw m a
    MonadCatch,
                  MonadReader Actions, MonadReader Terminal, MonadState TermPos,
                  MonadState TermRows, MonadReader Handles)

    instance MonadTrans Draw where
        lift :: forall (m :: * -> *) a. Monad m => m a -> Draw m a
    lift = ReaderT
      Actions
      (ReaderT
         Terminal (StateT TermRows (StateT TermPos (ReaderT Handles m))))
      a
    -> Draw m a
    forall (m :: * -> *) a.
    ReaderT
      Actions
      (ReaderT Terminal (StateT TermRows (StateT TermPos (PosixT m))))
      a
    -> Draw m a
    Draw (ReaderT
       Actions
       (ReaderT
          Terminal (StateT TermRows (StateT TermPos (ReaderT Handles m))))
       a
     -> Draw m a)
    -> (m a
        -> ReaderT
             Actions
             (ReaderT
                Terminal (StateT TermRows (StateT TermPos (ReaderT Handles m))))
             a)
    -> m a
    -> Draw m a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ReaderT
      Terminal (StateT TermRows (StateT TermPos (ReaderT Handles m))) a
    -> ReaderT
         Actions
         (ReaderT
            Terminal (StateT TermRows (StateT TermPos (ReaderT Handles m))))
         a
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
    (MonadTrans t, Monad m) =>
    m a -> t m a
    lift (ReaderT
       Terminal (StateT TermRows (StateT TermPos (ReaderT Handles m))) a
     -> ReaderT
          Actions
          (ReaderT
             Terminal (StateT TermRows (StateT TermPos (ReaderT Handles m))))
          a)
    -> (m a
        -> ReaderT
             Terminal (StateT TermRows (StateT TermPos (ReaderT Handles m))) a)
    -> m a
    -> ReaderT
         Actions
         (ReaderT
            Terminal (StateT TermRows (StateT TermPos (ReaderT Handles m))))
         a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . StateT TermRows (StateT TermPos (ReaderT Handles m)) a
    -> ReaderT
         Terminal (StateT TermRows (StateT TermPos (ReaderT Handles m))) a
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
    (MonadTrans t, Monad m) =>
    m a -> t m a
    lift (StateT TermRows (StateT TermPos (ReaderT Handles m)) a
     -> ReaderT
          Terminal (StateT TermRows (StateT TermPos (ReaderT Handles m))) a)
    -> (m a -> StateT TermRows (StateT TermPos (ReaderT Handles m)) a)
    -> m a
    -> ReaderT
         Terminal (StateT TermRows (StateT TermPos (ReaderT Handles m))) a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . StateT TermPos (ReaderT Handles m) a
    -> StateT TermRows (StateT TermPos (ReaderT Handles m)) a
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
    (MonadTrans t, Monad m) =>
    m a -> t m a
    lift (StateT TermPos (ReaderT Handles m) a
     -> StateT TermRows (StateT TermPos (ReaderT Handles m)) a)
    -> (m a -> StateT TermPos (ReaderT Handles m) a)
    -> m a
    -> StateT TermRows (StateT TermPos (ReaderT Handles m)) a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ReaderT Handles m a -> StateT TermPos (ReaderT Handles m) a
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
    (MonadTrans t, Monad m) =>
    m a -> t m a
    lift (ReaderT Handles m a -> StateT TermPos (ReaderT Handles m) a)
    -> (m a -> ReaderT Handles m a)
    -> m a
    -> StateT TermPos (ReaderT Handles m) a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . m a -> ReaderT Handles m a
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
    (MonadTrans t, Monad m) =>
    m a -> t m a
    lift

    evalDraw :: forall m . (MonadReader Layout m, CommandMonad m) => Terminal -> Actions -> EvalTerm (PosixT m)
    evalDraw :: forall (m :: * -> *).
    (MonadReader Layout m, CommandMonad m) =>
    Terminal -> Actions -> EvalTerm (PosixT m)
    evalDraw Terminal
    term Actions
    actions = (forall a. Draw m a -> PosixT m a)
    -> (forall a. PosixT m a -> Draw m a) -> EvalTerm (PosixT m)
    forall (m :: * -> *) (n :: * -> *).
    (Term n, CommandMonad n) =>
    (forall a. n a -> m a) -> (forall a. m a -> n a) -> EvalTerm m
    EvalTerm forall a. Draw m a -> PosixT m a
    eval forall a. PosixT m a -> Draw m a
    liftE
      where
        liftE :: PosixT m a -> Draw m a
    liftE = ReaderT
      Actions
      (ReaderT Terminal (StateT TermRows (StateT TermPos (PosixT m))))
      a
    -> Draw m a
    forall (m :: * -> *) a.
    ReaderT
      Actions
      (ReaderT Terminal (StateT TermRows (StateT TermPos (PosixT m))))
      a
    -> Draw m a
    Draw (ReaderT
       Actions
       (ReaderT Terminal (StateT TermRows (StateT TermPos (PosixT m))))
       a
     -> Draw m a)
    -> (PosixT m a
        -> ReaderT
             Actions
             (ReaderT Terminal (StateT TermRows (StateT TermPos (PosixT m))))
             a)
    -> PosixT m a
    -> Draw m a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ReaderT Terminal (StateT TermRows (StateT TermPos (PosixT m))) a
    -> ReaderT
         Actions
         (ReaderT Terminal (StateT TermRows (StateT TermPos (PosixT m))))
         a
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
    (MonadTrans t, Monad m) =>
    m a -> t m a
    lift (ReaderT Terminal (StateT TermRows (StateT TermPos (PosixT m))) a
     -> ReaderT
          Actions
          (ReaderT Terminal (StateT TermRows (StateT TermPos (PosixT m))))
          a)
    -> (PosixT m a
        -> ReaderT
             Terminal (StateT TermRows (StateT TermPos (PosixT m))) a)
    -> PosixT m a
    -> ReaderT
         Actions
         (ReaderT Terminal (StateT TermRows (StateT TermPos (PosixT m))))
         a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . StateT TermRows (StateT TermPos (PosixT m)) a
    -> ReaderT Terminal (StateT TermRows (StateT TermPos (PosixT m))) a
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
    (MonadTrans t, Monad m) =>
    m a -> t m a
    lift (StateT TermRows (StateT TermPos (PosixT m)) a
     -> ReaderT
          Terminal (StateT TermRows (StateT TermPos (PosixT m))) a)
    -> (PosixT m a -> StateT TermRows (StateT TermPos (PosixT m)) a)
    -> PosixT m a
    -> ReaderT Terminal (StateT TermRows (StateT TermPos (PosixT m))) a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . StateT TermPos (PosixT m) a
    -> StateT TermRows (StateT TermPos (PosixT m)) a
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
    (MonadTrans t, Monad m) =>
    m a -> t m a
    lift (StateT TermPos (PosixT m) a
     -> StateT TermRows (StateT TermPos (PosixT m)) a)
    -> (PosixT m a -> StateT TermPos (PosixT m) a)
    -> PosixT m a
    -> StateT TermRows (StateT TermPos (PosixT m)) a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . PosixT m a -> StateT TermPos (PosixT m) a
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
    (MonadTrans t, Monad m) =>
    m a -> t m a
    lift
        eval :: Draw m a -> PosixT m a
    eval = TermPos -> StateT TermPos (PosixT m) a -> PosixT m a
    forall (m :: * -> *) s a. Monad m => s -> StateT s m a -> m a
    evalStateT' TermPos
    initTermPos
                                (StateT TermPos (PosixT m) a -> PosixT m a)
    -> (Draw m a -> StateT TermPos (PosixT m) a)
    -> Draw m a
    -> PosixT m a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . TermRows
    -> StateT TermRows (StateT TermPos (PosixT m)) a
    -> StateT TermPos (PosixT m) a
    forall (m :: * -> *) s a. Monad m => s -> StateT s m a -> m a
    evalStateT' TermRows
    initTermRows
                                (StateT TermRows (StateT TermPos (PosixT m)) a
     -> StateT TermPos (PosixT m) a)
    -> (Draw m a -> StateT TermRows (StateT TermPos (PosixT m)) a)
    -> Draw m a
    -> StateT TermPos (PosixT m) a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Terminal
    -> ReaderT Terminal (StateT TermRows (StateT TermPos (PosixT m))) a
    -> StateT TermRows (StateT TermPos (PosixT m)) a
    forall r (m :: * -> *) a. r -> ReaderT r m a -> m a
    runReaderT' Terminal
    term
                                (ReaderT Terminal (StateT TermRows (StateT TermPos (PosixT m))) a
     -> StateT TermRows (StateT TermPos (PosixT m)) a)
    -> (Draw m a
        -> ReaderT
             Terminal (StateT TermRows (StateT TermPos (PosixT m))) a)
    -> Draw m a
    -> StateT TermRows (StateT TermPos (PosixT m)) a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Actions
    -> ReaderT
         Actions
         (ReaderT Terminal (StateT TermRows (StateT TermPos (PosixT m))))
         a
    -> ReaderT Terminal (StateT TermRows (StateT TermPos (PosixT m))) a
    forall r (m :: * -> *) a. r -> ReaderT r m a -> m a
    runReaderT' Actions
    actions
                                (ReaderT
       Actions
       (ReaderT Terminal (StateT TermRows (StateT TermPos (PosixT m))))
       a
     -> ReaderT
          Terminal (StateT TermRows (StateT TermPos (PosixT m))) a)
    -> (Draw m a
        -> ReaderT
             Actions
             (ReaderT Terminal (StateT TermRows (StateT TermPos (PosixT m))))
             a)
    -> Draw m a
    -> ReaderT Terminal (StateT TermRows (StateT TermPos (PosixT m))) a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Draw m a
    -> ReaderT
         Actions
         (ReaderT Terminal (StateT TermRows (StateT TermPos (PosixT m))))
         a
    forall (m :: * -> *) a.
    Draw m a
    -> ReaderT
         Actions
         (ReaderT Terminal (StateT TermRows (StateT TermPos (PosixT m))))
         a
    unDraw

    runTerminfoDraw :: Handles -> MaybeT IO RunTerm
    runTerminfoDraw :: Handles -> MaybeT IO RunTerm
    runTerminfoDraw Handles
    h = do
        Either SetupTermError Terminal
    mterm <- IO (Either SetupTermError Terminal)
    -> MaybeT IO (Either SetupTermError Terminal)
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO (Either SetupTermError Terminal)
     -> MaybeT IO (Either SetupTermError Terminal))
    -> IO (Either SetupTermError Terminal)
    -> MaybeT IO (Either SetupTermError Terminal)
    forall a b. (a -> b) -> a -> b
    $ IO Terminal -> IO (Either SetupTermError Terminal)
    forall e a. Exception e => IO a -> IO (Either e a)
    Exception.try IO Terminal
    setupTermFromEnv
        case Either SetupTermError Terminal
    mterm of
            Left (SetupTermError
    _::SetupTermError) -> MaybeT IO RunTerm
    forall (m :: * -> *) a. MonadPlus m => m a
    mzero
            Right Terminal
    term -> do
                Actions
    actions <- IO (Maybe Actions) -> MaybeT IO Actions
    forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
    MaybeT (IO (Maybe Actions) -> MaybeT IO Actions)
    -> IO (Maybe Actions) -> MaybeT IO Actions
    forall a b. (a -> b) -> a -> b
    $ Maybe Actions -> IO (Maybe Actions)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Maybe Actions -> IO (Maybe Actions))
    -> Maybe Actions -> IO (Maybe Actions)
    forall a b. (a -> b) -> a -> b
    $ Terminal -> Capability Actions -> Maybe Actions
    forall a. Terminal -> Capability a -> Maybe a
    getCapability Terminal
    term Capability Actions
    getActions
                IO RunTerm -> MaybeT IO RunTerm
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO RunTerm -> MaybeT IO RunTerm)
    -> IO RunTerm -> MaybeT IO RunTerm
    forall a b. (a -> b) -> a -> b
    $ Handles
    -> [IO (Maybe Layout)]
    -> [(String, Key)]
    -> (forall (m :: * -> *) b. (MonadIO m, MonadMask m) => m b -> m b)
    -> (forall (m :: * -> *).
        (MonadMask m, CommandMonad m) =>
        EvalTerm (PosixT m))
    -> IO RunTerm
    posixRunTerm Handles
    h (Handles -> [IO (Maybe Layout)]
    posixLayouts Handles
    h [IO (Maybe Layout)] -> [IO (Maybe Layout)] -> [IO (Maybe Layout)]
    forall a. [a] -> [a] -> [a]
    ++ [Terminal -> IO (Maybe Layout)
    tinfoLayout Terminal
    term])
                    (Terminal -> [(String, Key)]
    terminfoKeys Terminal
    term)
                    (Handle -> Terminal -> m b -> m b
    forall (m :: * -> *) a.
    (MonadIO m, MonadMask m) =>
    Handle -> Terminal -> m a -> m a
    wrapKeypad (Handles -> Handle
    ehOut Handles
    h) Terminal
    term)
                    (Terminal -> Actions -> EvalTerm (PosixT m)
    forall (m :: * -> *).
    (MonadReader Layout m, CommandMonad m) =>
    Terminal -> Actions -> EvalTerm (PosixT m)
    evalDraw Terminal
    term Actions
    actions)

    -- If the keypad on/off capabilities are defined, wrap the computation with them.
    wrapKeypad :: (MonadIO m, MonadMask m) => Handle -> Terminal -> m a -> m a
    wrapKeypad :: forall (m :: * -> *) a.
    (MonadIO m, MonadMask m) =>
    Handle -> Terminal -> m a -> m a
    wrapKeypad Handle
    h Terminal
    term m a
    f = (Capability TermOutput -> m ()
    maybeOutput Capability TermOutput
    forall s. TermStr s => Capability s
    keypadOn m () -> m a -> m a
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> m a
    f)
                                m a -> m () -> m a
    forall (m :: * -> *) a b. MonadMask m => m a -> m b -> m a
    `finally` Capability TermOutput -> m ()
    maybeOutput Capability TermOutput
    forall s. TermStr s => Capability s
    keypadOff
      where
        maybeOutput :: Capability TermOutput -> m ()
    maybeOutput = IO () -> m ()
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO () -> m ())
    -> (Capability TermOutput -> IO ())
    -> Capability TermOutput
    -> m ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Handle -> Terminal -> TermOutput -> IO ()
    hRunTermOutput Handle
    h Terminal
    term (TermOutput -> IO ())
    -> (Capability TermOutput -> TermOutput)
    -> Capability TermOutput
    -> IO ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    .
                                TermOutput -> Maybe TermOutput -> TermOutput
    forall a. a -> Maybe a -> a
    fromMaybe TermOutput
    forall a. Monoid a => a
    mempty (Maybe TermOutput -> TermOutput)
    -> (Capability TermOutput -> Maybe TermOutput)
    -> Capability TermOutput
    -> TermOutput
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Terminal -> Capability TermOutput -> Maybe TermOutput
    forall a. Terminal -> Capability a -> Maybe a
    getCapability Terminal
    term

    tinfoLayout :: Terminal -> IO (Maybe Layout)
    tinfoLayout :: Terminal -> IO (Maybe Layout)
    tinfoLayout Terminal
    term = Maybe Layout -> IO (Maybe Layout)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Maybe Layout -> IO (Maybe Layout))
    -> Maybe Layout -> IO (Maybe Layout)
    forall a b. (a -> b) -> a -> b
    $ Terminal -> Capability Layout -> Maybe Layout
    forall a. Terminal -> Capability a -> Maybe a
    getCapability Terminal
    term (Capability Layout -> Maybe Layout)
    -> Capability Layout -> Maybe Layout
    forall a b. (a -> b) -> a -> b
    $ do
                            Int
    c <- Capability Int
    termColumns
                            Int
    r <- Capability Int
    termLines
                            Layout -> Capability Layout
    forall (m :: * -> *) a. Monad m => a -> m a
    return Layout :: Int -> Int -> Layout
    Layout {height :: Int
    height=Int
    r,width :: Int
    width=Int
    c}

    terminfoKeys :: Terminal -> [(String,Key)]
    terminfoKeys :: Terminal -> [(String, Key)]
    terminfoKeys Terminal
    term = ((Capability String, Key) -> Maybe (String, Key))
    -> [(Capability String, Key)] -> [(String, Key)]
    forall a b. (a -> Maybe b) -> [a] -> [b]
    mapMaybe (Capability String, Key) -> Maybe (String, Key)
    forall {a} {b}. (Capability a, b) -> Maybe (a, b)
    getSequence [(Capability String, Key)]
    keyCapabilities
        where
            getSequence :: (Capability a, b) -> Maybe (a, b)
    getSequence (Capability a
    cap,b
    x) = do
                                a
    keys <- Terminal -> Capability a -> Maybe a
    forall a. Terminal -> Capability a -> Maybe a
    getCapability Terminal
    term Capability a
    cap
                                (a, b) -> Maybe (a, b)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (a
    keys,b
    x)
            keyCapabilities :: [(Capability String, Key)]
    keyCapabilities =
                    [(Capability String
    keyLeft,      BaseKey -> Key
    simpleKey BaseKey
    LeftKey)
                    ,(Capability String
    keyRight,      BaseKey -> Key
    simpleKey BaseKey
    RightKey)
                    ,(Capability String
    keyUp,         BaseKey -> Key
    simpleKey BaseKey
    UpKey)
                    ,(Capability String
    keyDown,       BaseKey -> Key
    simpleKey BaseKey
    DownKey)
                    ,(Capability String
    keyBackspace,  BaseKey -> Key
    simpleKey BaseKey
    Backspace)
                    ,(Capability String
    keyDeleteChar, BaseKey -> Key
    simpleKey BaseKey
    Delete)
                    ,(Capability String
    keyHome,       BaseKey -> Key
    simpleKey BaseKey
    Home)
                    ,(Capability String
    keyEnd,        BaseKey -> Key
    simpleKey BaseKey
    End)
                    ,(Capability String
    keyPageDown,   BaseKey -> Key
    simpleKey BaseKey
    PageDown)
                    ,(Capability String
    keyPageUp,     BaseKey -> Key
    simpleKey BaseKey
    PageUp)
                    ,(Capability String
    keyEnter,      BaseKey -> Key
    simpleKey (BaseKey -> Key) -> BaseKey -> Key
    forall a b. (a -> b) -> a -> b
    $ Char -> BaseKey
    KeyChar Char
    '\n')
                    ]

    ----------------------------------------------------------------
    -- Terminal output actions
    --
    -- We combine all of the drawing commands into one big TermAction,
    -- via a writer monad, and then output them all at once.
    -- This prevents flicker, i.e., the cursor appearing briefly
    -- in an intermediate position.

    type TermAction = Actions -> TermOutput

    type ActionT = Writer.WriterT TermAction

    type ActionM a = forall m . (MonadReader Layout m, MonadIO m) => ActionT (Draw m) a

    runActionT :: MonadIO m => ActionT (Draw m) a -> Draw m a
    runActionT :: forall (m :: * -> *) a. MonadIO m => ActionT (Draw m) a -> Draw m a
    runActionT ActionT (Draw m) a
    m = do
        (a
    x,TermAction
    action) <- ActionT (Draw m) a -> Draw m (a, TermAction)
    forall w (m :: * -> *) a. WriterT w m a -> m (a, w)
    Writer.runWriterT ActionT (Draw m) a
    m
        TermOutput
    toutput <- TermAction -> Draw m TermOutput
    forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
    asks TermAction
    action
        Terminal
    term <- Draw m Terminal
    forall r (m :: * -> *). MonadReader r m => m r
    ask
        Handle
    ttyh <- (Handles -> Handle) -> Draw m Handles -> Draw m Handle
    forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
    liftM Handles -> Handle
    ehOut Draw m Handles
    forall r (m :: * -> *). MonadReader r m => m r
    ask
        IO () -> Draw m ()
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO () -> Draw m ()) -> IO () -> Draw m ()
    forall a b. (a -> b) -> a -> b
    $ Handle -> Terminal -> TermOutput -> IO ()
    hRunTermOutput Handle
    ttyh Terminal
    term TermOutput
    toutput
        a -> Draw m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return a
    x

    output :: TermAction -> ActionM ()
    output :: TermAction -> ActionM ()
    output TermAction
    t = TermAction -> WriterT TermAction (Draw m) ()
    forall (m :: * -> *) w. Monad m => w -> WriterT w m ()
    Writer.tell TermAction
    t  -- NB: explicit argument enables build with ghc-6.12.3
                              -- (Probably related to the monomorphism restriction;
                              -- see GHC ticket #1749).

    outputText :: String -> ActionM ()
    outputText :: String -> ActionM ()
    outputText String
    s = TermAction -> ActionM ()
    output (TermOutput -> TermAction
    forall a b. a -> b -> a
    const (String -> TermOutput
    termText String
    s))

    left,right,up :: Int -> TermAction
    left :: Int -> TermAction
    left = (Actions -> Int -> TermOutput) -> Int -> TermAction
    forall a b c. (a -> b -> c) -> b -> a -> c
    flip Actions -> Int -> TermOutput
    leftA
    right :: Int -> TermAction
    right = (Actions -> Int -> TermOutput) -> Int -> TermAction
    forall a b c. (a -> b -> c) -> b -> a -> c
    flip Actions -> Int -> TermOutput
    rightA
    up :: Int -> TermAction
    up = (Actions -> Int -> TermOutput) -> Int -> TermAction
    forall a b c. (a -> b -> c) -> b -> a -> c
    flip Actions -> Int -> TermOutput
    upA

    clearAll :: LinesAffected -> TermAction
    clearAll :: Int -> TermAction
    clearAll = (Actions -> Int -> TermOutput) -> Int -> TermAction
    forall a b c. (a -> b -> c) -> b -> a -> c
    flip Actions -> Int -> TermOutput
    clearAllA

    mreplicate :: Monoid m => Int -> m -> m
    mreplicate :: forall m. Monoid m => Int -> m -> m
    mreplicate Int
    n m
    m
        | Int
    n Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    <= Int
    0    = m
    forall a. Monoid a => a
    mempty
        | Bool
    otherwise = m
    m m -> m -> m
    forall m. Monoid m => m -> m -> m
    `mappend` Int -> m -> m
    forall m. Monoid m => Int -> m -> m
    mreplicate (Int
    nInt -> Int -> Int
    forall a. Num a => a -> a -> a
    -Int
    1) m
    m

    -- We don't need to bother encoding the spaces.
    spaces :: Int -> TermAction
    spaces :: Int -> TermAction
    spaces Int
    0 = TermAction
    forall a. Monoid a => a
    mempty
    spaces Int
    1 = TermOutput -> TermAction
    forall a b. a -> b -> a
    const (TermOutput -> TermAction) -> TermOutput -> TermAction
    forall a b. (a -> b) -> a -> b
    $ String -> TermOutput
    termText String
    " " -- share when possible
    spaces Int
    n = TermOutput -> TermAction
    forall a b. a -> b -> a
    const (TermOutput -> TermAction) -> TermOutput -> TermAction
    forall a b. (a -> b) -> a -> b
    $ String -> TermOutput
    termText (String -> TermOutput) -> String -> TermOutput
    forall a b. (a -> b) -> a -> b
    $ Int -> Char -> String
    forall a. Int -> a -> [a]
    replicate Int
    n Char
    ' '

    changePos :: TermPos -> TermPos -> TermAction
    changePos :: TermPos -> TermPos -> TermAction
    changePos TermPos {termRow :: TermPos -> Int
    termRow=Int
    r1, termCol :: TermPos -> Int
    termCol=Int
    c1} TermPos {termRow :: TermPos -> Int
    termRow=Int
    r2, termCol :: TermPos -> Int
    termCol=Int
    c2}
        | Int
    r1 Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    == Int
    r2 = if Int
    c1 Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    < Int
    c2 then Int -> TermAction
    right (Int
    c2Int -> Int -> Int
    forall a. Num a => a -> a -> a
    -Int
    c1) else Int -> TermAction
    left (Int
    c1Int -> Int -> Int
    forall a. Num a => a -> a -> a
    -Int
    c2)
        | Int
    r1 Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    > Int
    r2 = TermAction
    cr TermAction -> TermAction -> TermAction
    forall m. Monoid m => m -> m -> m
    <#> Int -> TermAction
    up (Int
    r1Int -> Int -> Int
    forall a. Num a => a -> a -> a
    -Int
    r2) TermAction -> TermAction -> TermAction
    forall m. Monoid m => m -> m -> m
    <#> Int -> TermAction
    right Int
    c2
        | Bool
    otherwise = TermAction
    cr TermAction -> TermAction -> TermAction
    forall m. Monoid m => m -> m -> m
    <#> Int -> TermAction -> TermAction
    forall m. Monoid m => Int -> m -> m
    mreplicate (Int
    r2Int -> Int -> Int
    forall a. Num a => a -> a -> a
    -Int
    r1) TermAction
    nl TermAction -> TermAction -> TermAction
    forall m. Monoid m => m -> m -> m
    <#> Int -> TermAction
    right Int
    c2

    moveToPos :: TermPos -> ActionM ()
    moveToPos :: TermPos -> ActionM ()
    moveToPos TermPos
    p = do
        TermPos
    oldP <- WriterT TermAction (Draw m) TermPos
    forall s (m :: * -> *). MonadState s m => m s
    get
        TermPos -> ActionT (Draw m) ()
    forall s (m :: * -> *). MonadState s m => s -> m ()
    put TermPos
    p
        TermAction -> ActionT (Draw m) ()
    TermAction -> ActionM ()
    output (TermAction -> ActionT (Draw m) ())
    -> TermAction -> ActionT (Draw m) ()
    forall a b. (a -> b) -> a -> b
    $ TermPos -> TermPos -> TermAction
    changePos TermPos
    oldP TermPos
    p

    moveRelative :: Int -> ActionM ()
    moveRelative :: Int -> ActionM ()
    moveRelative Int
    n = (Layout -> TermRows -> TermPos -> TermPos)
    -> WriterT TermAction (Draw m) Layout
    -> WriterT TermAction (Draw m) TermRows
    -> WriterT TermAction (Draw m) TermPos
    -> WriterT TermAction (Draw m) TermPos
    forall (m :: * -> *) a1 a2 a3 r.
    Monad m =>
    (a1 -> a2 -> a3 -> r) -> m a1 -> m a2 -> m a3 -> m r
    liftM3 (Int -> Layout -> TermRows -> TermPos -> TermPos
    advancePos Int
    n) WriterT TermAction (Draw m) Layout
    forall r (m :: * -> *). MonadReader r m => m r
    ask WriterT TermAction (Draw m) TermRows
    forall s (m :: * -> *). MonadState s m => m s
    get WriterT TermAction (Draw m) TermPos
    forall s (m :: * -> *). MonadState s m => m s
    get
                        WriterT TermAction (Draw m) TermPos
    -> (TermPos -> WriterT TermAction (Draw m) ())
    -> WriterT TermAction (Draw m) ()
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= \TermPos
    p -> TermPos -> ActionM ()
    moveToPos TermPos
    p

    -- Note that these move by a certain number of cells, not graphemes.
    changeRight, changeLeft :: Int -> ActionM ()
    changeRight :: Int -> ActionM ()
    changeRight Int
    n   | Int
    n Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    <= Int
    0 = () -> WriterT TermAction (Draw m) ()
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
                    | Bool
    otherwise = Int -> ActionM ()
    moveRelative Int
    n
    changeLeft :: Int -> ActionM ()
    changeLeft Int
    n    | Int
    n Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    <= Int
    0 = () -> WriterT TermAction (Draw m) ()
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
                    | Bool
    otherwise = Int -> ActionM ()
    moveRelative (Int -> Int
    forall a. Num a => a -> a
    negate Int
    n)

    -- TODO: this could be more efficient by only checking intermediate rows.
    -- TODO: this is worth handling with QuickCheck.
    advancePos :: Int -> Layout -> TermRows -> TermPos -> TermPos
    advancePos :: Int -> Layout -> TermRows -> TermPos -> TermPos
    advancePos Int
    k Layout {width :: Layout -> Int
    width=Int
    w} TermRows
    rs TermPos
    p = Int -> TermPos
    indexToPos (Int -> TermPos) -> Int -> TermPos
    forall a b. (a -> b) -> a -> b
    $ Int
    k Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    posIndex
      where
        posIndex :: Int
    posIndex = TermPos -> Int
    termCol TermPos
    p Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + [Int] -> Int
    sum' ((Int -> Int) -> [Int] -> [Int]
    forall a b. (a -> b) -> [a] -> [b]
    map (TermRows -> Int -> Int
    lookupCells TermRows
    rs)
                                                [Int
    0..TermPos -> Int
    termRow TermPos
    pInt -> Int -> Int
    forall a. Num a => a -> a -> a
    -Int
    1])
        indexToPos :: Int -> TermPos
    indexToPos Int
    n = Int -> Int -> TermPos
    loopFindRow Int
    0 Int
    n
        loopFindRow :: Int -> Int -> TermPos
    loopFindRow Int
    r Int
    m = Int
    r Int -> TermPos -> TermPos
    `seq` Int
    m Int -> TermPos -> TermPos
    `seq` let
            thisRowSize :: Int
    thisRowSize = TermRows -> Int -> Int
    lookupCells TermRows
    rs Int
    r
            in if Int
    m Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    < Int
    thisRowSize
                    Bool -> Bool -> Bool
    || (Int
    m Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    == Int
    thisRowSize Bool -> Bool -> Bool
    && Int
    m Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    < Int
    w)
                    Bool -> Bool -> Bool
    || Int
    thisRowSize Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    <= Int
    0 -- This shouldn't happen in practice,
                                        -- but double-check to prevent an infinite loop
                    then TermPos :: Int -> Int -> TermPos
    TermPos {termRow :: Int
    termRow=Int
    r, termCol :: Int
    termCol=Int
    m}
                    else Int -> Int -> TermPos
    loopFindRow (Int
    rInt -> Int -> Int
    forall a. Num a => a -> a -> a
    +Int
    1) (Int
    mInt -> Int -> Int
    forall a. Num a => a -> a -> a
    -Int
    thisRowSize)

    sum' :: [Int] -> Int
    sum' :: [Int] -> Int
    sum' = (Int -> Int -> Int) -> Int -> [Int] -> Int
    forall (t :: * -> *) b a.
    Foldable t =>
    (b -> a -> b) -> b -> t a -> b
    foldl' Int -> Int -> Int
    forall a. Num a => a -> a -> a
    (+) Int
    0

    ----------------------------------------------------------------
    -- Text printing actions

    printText :: [Grapheme] -> ActionM ()
    printText :: [Grapheme] -> ActionM ()
    printText [] = () -> WriterT TermAction (Draw m) ()
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
    printText [Grapheme]
    gs = do
        -- First, get the monadic parameters:
        Int
    w <- (Layout -> Int) -> WriterT TermAction (Draw m) Int
    forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
    asks Layout -> Int
    width
        TermPos {termRow :: TermPos -> Int
    termRow=Int
    r, termCol :: TermPos -> Int
    termCol=Int
    c} <- WriterT TermAction (Draw m) TermPos
    forall s (m :: * -> *). MonadState s m => m s
    get
        -- Now, split off as much as will fit on the rest of this row:
        let ([Grapheme]
    thisLine,[Grapheme]
    rest,Int
    thisWidth) = Int -> [Grapheme] -> ([Grapheme], [Grapheme], Int)
    splitAtWidth (Int
    wInt -> Int -> Int
    forall a. Num a => a -> a -> a
    -Int
    c) [Grapheme]
    gs
        let lineWidth :: Int
    lineWidth = Int
    c Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    thisWidth
        -- Finally, actually print out the relevant text.
        String -> ActionM ()
    outputText ([Grapheme] -> String
    graphemesToString [Grapheme]
    thisLine)
        (TermRows -> TermRows) -> WriterT TermAction (Draw m) ()
    forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
    modify ((TermRows -> TermRows) -> WriterT TermAction (Draw m) ())
    -> (TermRows -> TermRows) -> WriterT TermAction (Draw m) ()
    forall a b. (a -> b) -> a -> b
    $ Int -> Int -> TermRows -> TermRows
    setRow Int
    r Int
    lineWidth
        if [Grapheme] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [Grapheme]
    rest Bool -> Bool -> Bool
    && Int
    lineWidth Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    < Int
    w
            then  -- everything fits on one line without wrapping
                TermPos -> WriterT TermAction (Draw m) ()
    forall s (m :: * -> *). MonadState s m => s -> m ()
    put TermPos :: Int -> Int -> TermPos
    TermPos {termRow :: Int
    termRow=Int
    r, termCol :: Int
    termCol=Int
    lineWidth}
            else do -- Must wrap to the next line
                TermPos -> WriterT TermAction (Draw m) ()
    forall s (m :: * -> *). MonadState s m => s -> m ()
    put TermPos :: Int -> Int -> TermPos
    TermPos {termRow :: Int
    termRow=Int
    rInt -> Int -> Int
    forall a. Num a => a -> a -> a
    +Int
    1,termCol :: Int
    termCol=Int
    0}
                TermAction -> WriterT TermAction (Draw m) ()
    TermAction -> ActionM ()
    output (TermAction -> WriterT TermAction (Draw m) ())
    -> TermAction -> WriterT TermAction (Draw m) ()
    forall a b. (a -> b) -> a -> b
    $ if Int
    lineWidth Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    == Int
    w then TermAction
    wrapLine else Int -> TermAction
    spaces (Int
    wInt -> Int -> Int
    forall a. Num a => a -> a -> a
    -Int
    lineWidth)
                [Grapheme] -> ActionM ()
    printText [Grapheme]
    rest

    ----------------------------------------------------------------
    -- High-level Term implementation

    drawLineDiffT :: LineChars -> LineChars -> ActionM ()
    drawLineDiffT :: LineChars -> LineChars -> ActionM ()
    drawLineDiffT ([Grapheme]
    xs1,[Grapheme]
    ys1) ([Grapheme]
    xs2,[Grapheme]
    ys2) = case [Grapheme] -> [Grapheme] -> LineChars
    forall a. Eq a => [a] -> [a] -> ([a], [a])
    matchInit [Grapheme]
    xs1 [Grapheme]
    xs2 of
        ([],[])     | [Grapheme]
    ys1 [Grapheme] -> [Grapheme] -> Bool
    forall a. Eq a => a -> a -> Bool
    == [Grapheme]
    ys2            -> () -> ActionT (Draw m) ()
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
        ([Grapheme]
    xs1',[])   | [Grapheme]
    xs1' [Grapheme] -> [Grapheme] -> [Grapheme]
    forall a. [a] -> [a] -> [a]
    ++ [Grapheme]
    ys1 [Grapheme] -> [Grapheme] -> Bool
    forall a. Eq a => a -> a -> Bool
    == [Grapheme]
    ys2    -> Int -> ActionM ()
    changeLeft ([Grapheme] -> Int
    gsWidth [Grapheme]
    xs1')
        ([],[Grapheme]
    xs2')   | [Grapheme]
    ys1 [Grapheme] -> [Grapheme] -> Bool
    forall a. Eq a => a -> a -> Bool
    == [Grapheme]
    xs2' [Grapheme] -> [Grapheme] -> [Grapheme]
    forall a. [a] -> [a] -> [a]
    ++ [Grapheme]
    ys2    -> Int -> ActionM ()
    changeRight ([Grapheme] -> Int
    gsWidth [Grapheme]
    xs2')
        ([Grapheme]
    xs1',[Grapheme]
    xs2')                         -> do
            TermRows
    oldRS <- WriterT TermAction (Draw m) TermRows
    forall s (m :: * -> *). MonadState s m => m s
    get
            Int -> ActionM ()
    changeLeft ([Grapheme] -> Int
    gsWidth [Grapheme]
    xs1')
            [Grapheme] -> ActionM ()
    printText [Grapheme]
    xs2'
            TermPos
    p <- WriterT TermAction (Draw m) TermPos
    forall s (m :: * -> *). MonadState s m => m s
    get
            [Grapheme] -> ActionM ()
    printText [Grapheme]
    ys2
            TermRows -> ActionM ()
    clearDeadText TermRows
    oldRS
            TermPos -> ActionM ()
    moveToPos TermPos
    p

    -- The number of nonempty lines after the current row position.
    getLinesLeft :: ActionM Int
    getLinesLeft :: ActionM Int
    getLinesLeft = do
        TermPos
    p <- WriterT TermAction (Draw m) TermPos
    forall s (m :: * -> *). MonadState s m => m s
    get
        TermRows
    rc <- WriterT TermAction (Draw m) TermRows
    forall s (m :: * -> *). MonadState s m => m s
    get
        Int -> ActionT (Draw m) Int
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Int -> ActionT (Draw m) Int) -> Int -> ActionT (Draw m) Int
    forall a b. (a -> b) -> a -> b
    $ Int -> Int -> Int
    forall a. Ord a => a -> a -> a
    max Int
    0 (TermRows -> Int
    lastRow TermRows
    rc Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - TermPos -> Int
    termRow TermPos
    p)

    clearDeadText :: TermRows -> ActionM ()
    clearDeadText :: TermRows -> ActionM ()
    clearDeadText TermRows
    oldRS = do
        TermPos {termRow :: TermPos -> Int
    termRow = Int
    r, termCol :: TermPos -> Int
    termCol = Int
    c} <- WriterT TermAction (Draw m) TermPos
    forall s (m :: * -> *). MonadState s m => m s
    get
        let extraRows :: Int
    extraRows = TermRows -> Int
    lastRow TermRows
    oldRS Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    r
        if Int
    extraRows Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    < Int
    0
                Bool -> Bool -> Bool
    || (Int
    extraRows Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    == Int
    0 Bool -> Bool -> Bool
    && TermRows -> Int -> Int
    lookupCells TermRows
    oldRS Int
    r Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    <= Int
    c)
            then () -> ActionT (Draw m) ()
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
            else do
                (TermRows -> TermRows) -> ActionT (Draw m) ()
    forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
    modify ((TermRows -> TermRows) -> ActionT (Draw m) ())
    -> (TermRows -> TermRows) -> ActionT (Draw m) ()
    forall a b. (a -> b) -> a -> b
    $ Int -> Int -> TermRows -> TermRows
    setRow Int
    r Int
    c
                Bool -> ActionT (Draw m) () -> ActionT (Draw m) ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (Int
    extraRows Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    /= Int
    0)
                    (ActionT (Draw m) () -> ActionT (Draw m) ())
    -> ActionT (Draw m) () -> ActionT (Draw m) ()
    forall a b. (a -> b) -> a -> b
    $ TermPos -> ActionT (Draw m) ()
    forall s (m :: * -> *). MonadState s m => s -> m ()
    put TermPos :: Int -> Int -> TermPos
    TermPos {termRow :: Int
    termRow = Int
    r Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    extraRows, termCol :: Int
    termCol=Int
    0}
                TermAction -> ActionT (Draw m) ()
    TermAction -> ActionM ()
    output (TermAction -> ActionT (Draw m) ())
    -> TermAction -> ActionT (Draw m) ()
    forall a b. (a -> b) -> a -> b
    $ TermAction
    clearToLineEnd TermAction -> TermAction -> TermAction
    forall m. Monoid m => m -> m -> m
    <#> Int -> TermAction -> TermAction
    forall m. Monoid m => Int -> m -> m
    mreplicate Int
    extraRows (TermAction
    nl TermAction -> TermAction -> TermAction
    forall m. Monoid m => m -> m -> m
    <#> TermAction
    clearToLineEnd)

    clearLayoutT :: ActionM ()
    clearLayoutT :: ActionM ()
    clearLayoutT = do
        Int
    h <- (Layout -> Int) -> WriterT TermAction (Draw m) Int
    forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
    asks Layout -> Int
    height
        TermAction -> ActionM ()
    output (Int -> TermAction
    clearAll Int
    h)
        TermPos -> ActionT (Draw m) ()
    forall s (m :: * -> *). MonadState s m => s -> m ()
    put TermPos
    initTermPos

    moveToNextLineT :: ActionM ()
    moveToNextLineT :: ActionM ()
    moveToNextLineT = do
        Int
    lleft <- ActionT (Draw m) Int
    ActionM Int
    getLinesLeft
        TermAction -> ActionT (Draw m) ()
    TermAction -> ActionM ()
    output (TermAction -> ActionT (Draw m) ())
    -> TermAction -> ActionT (Draw m) ()
    forall a b. (a -> b) -> a -> b
    $ Int -> TermAction -> TermAction
    forall m. Monoid m => Int -> m -> m
    mreplicate (Int
    lleftInt -> Int -> Int
    forall a. Num a => a -> a -> a
    +Int
    1) TermAction
    nl
        TermPos -> ActionT (Draw m) ()
    forall s (m :: * -> *). MonadState s m => s -> m ()
    put TermPos
    initTermPos
        TermRows -> ActionT (Draw m) ()
    forall s (m :: * -> *). MonadState s m => s -> m ()
    put TermRows
    initTermRows

    repositionT :: Layout -> LineChars -> ActionM ()
    repositionT :: Layout -> LineChars -> ActionM ()
    repositionT Layout
    _ LineChars
    s = do
        TermPos
    oldPos <- WriterT TermAction (Draw m) TermPos
    forall s (m :: * -> *). MonadState s m => m s
    get
        Int
    l <- ActionT (Draw m) Int
    ActionM Int
    getLinesLeft
        TermAction -> ActionT (Draw m) ()
    TermAction -> ActionM ()
    output (TermAction -> ActionT (Draw m) ())
    -> TermAction -> ActionT (Draw m) ()
    forall a b. (a -> b) -> a -> b
    $ TermAction
    cr TermAction -> TermAction -> TermAction
    forall m. Monoid m => m -> m -> m
    <#> Int -> TermAction -> TermAction
    forall m. Monoid m => Int -> m -> m
    mreplicate Int
    l TermAction
    nl
                TermAction -> TermAction -> TermAction
    forall m. Monoid m => m -> m -> m
    <#> Int -> TermAction -> TermAction
    forall m. Monoid m => Int -> m -> m
    mreplicate (Int
    l Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + TermPos -> Int
    termRow TermPos
    oldPos) (TermAction
    clearToLineEnd TermAction -> TermAction -> TermAction
    forall m. Monoid m => m -> m -> m
    <#> Int -> TermAction
    up Int
    1)
        TermPos -> ActionT (Draw m) ()
    forall s (m :: * -> *). MonadState s m => s -> m ()
    put TermPos
    initTermPos
        TermRows -> ActionT (Draw m) ()
    forall s (m :: * -> *). MonadState s m => s -> m ()
    put TermRows
    initTermRows
        LineChars -> LineChars -> ActionM ()
    drawLineDiffT ([],[]) LineChars
    s

    instance (MonadIO m, MonadMask m, MonadReader Layout m) => Term (Draw m) where
        drawLineDiff :: LineChars -> LineChars -> Draw m ()
    drawLineDiff LineChars
    xs LineChars
    ys = ActionT (Draw m) () -> Draw m ()
    forall (m :: * -> *) a. MonadIO m => ActionT (Draw m) a -> Draw m a
    runActionT (ActionT (Draw m) () -> Draw m ())
    -> ActionT (Draw m) () -> Draw m ()
    forall a b. (a -> b) -> a -> b
    $ LineChars -> LineChars -> ActionM ()
    drawLineDiffT LineChars
    xs LineChars
    ys
        reposition :: Layout -> LineChars -> Draw m ()
    reposition Layout
    layout LineChars
    lc = ActionT (Draw m) () -> Draw m ()
    forall (m :: * -> *) a. MonadIO m => ActionT (Draw m) a -> Draw m a
    runActionT (ActionT (Draw m) () -> Draw m ())
    -> ActionT (Draw m) () -> Draw m ()
    forall a b. (a -> b) -> a -> b
    $ Layout -> LineChars -> ActionM ()
    repositionT Layout
    layout LineChars
    lc

        printLines :: [String] -> Draw m ()
    printLines = (String -> Draw m ()) -> [String] -> Draw m ()
    forall (t :: * -> *) (m :: * -> *) a b.
    (Foldable t, Monad m) =>
    (a -> m b) -> t a -> m ()
    mapM_ ((String -> Draw m ()) -> [String] -> Draw m ())
    -> (String -> Draw m ()) -> [String] -> Draw m ()
    forall a b. (a -> b) -> a -> b
    $ \String
    line -> ActionT (Draw m) () -> Draw m ()
    forall (m :: * -> *) a. MonadIO m => ActionT (Draw m) a -> Draw m a
    runActionT (ActionT (Draw m) () -> Draw m ())
    -> ActionT (Draw m) () -> Draw m ()
    forall a b. (a -> b) -> a -> b
    $ do
                                        String -> ActionM ()
    outputText String
    line
                                        TermAction -> ActionM ()
    output TermAction
    nl
        clearLayout :: Draw m ()
    clearLayout = ActionT (Draw m) () -> Draw m ()
    forall (m :: * -> *) a. MonadIO m => ActionT (Draw m) a -> Draw m a
    runActionT ActionT (Draw m) ()
    ActionM ()
    clearLayoutT
        moveToNextLine :: LineChars -> Draw m ()
    moveToNextLine LineChars
    _ = ActionT (Draw m) () -> Draw m ()
    forall (m :: * -> *) a. MonadIO m => ActionT (Draw m) a -> Draw m a
    runActionT ActionT (Draw m) ()
    ActionM ()
    moveToNextLineT
        ringBell :: Bool -> Draw m ()
    ringBell Bool
    True = ActionT (Draw m) () -> Draw m ()
    forall (m :: * -> *) a. MonadIO m => ActionT (Draw m) a -> Draw m a
    runActionT (ActionT (Draw m) () -> Draw m ())
    -> ActionT (Draw m) () -> Draw m ()
    forall a b. (a -> b) -> a -> b
    $ TermAction -> ActionM ()
    output TermAction
    bellAudible
        ringBell Bool
    False = ActionT (Draw m) () -> Draw m ()
    forall (m :: * -> *) a. MonadIO m => ActionT (Draw m) a -> Draw m a
    runActionT (ActionT (Draw m) () -> Draw m ())
    -> ActionT (Draw m) () -> Draw m ()
    forall a b. (a -> b) -> a -> b
    $ TermAction -> ActionM ()
    output TermAction
    bellVisual