    {-# OPTIONS_HADDOCK not-home #-}
    module Hedgehog.Internal.Region (
        Region(..)
      , newEmptyRegion
      , newOpenRegion
      , openRegion
      , setRegion
      , displayRegions
      , displayRegion
      , moveToBottom
      , finishRegion
      ) where

    import           Control.Concurrent.STM (STM, TVar)
    import qualified Control.Concurrent.STM.TMVar as TMVar
    import qualified Control.Concurrent.STM.TVar as TVar
    import           Control.Exception.Safe (MonadMask, bracket)
    import           Control.Monad.IO.Class (MonadIO(..))

    import           System.Console.Regions (ConsoleRegion, RegionLayout(..), LiftRegion(..))
    import qualified System.Console.Regions as Console

    data Body =
        Empty
      | Open ConsoleRegion
      | Closed

    newtype Region =
      Region {
          Region -> TVar Body
    unRegion :: TVar Body
        }

    newEmptyRegion :: LiftRegion m => m Region
    newEmptyRegion :: forall (m :: * -> *). LiftRegion m => m Region
    newEmptyRegion =
      STM Region -> m Region
    forall a. STM a -> m a
    forall (m :: * -> *) a. LiftRegion m => STM a -> m a
    liftRegion (STM Region -> m Region) -> STM Region -> m Region
    forall a b. (a -> b) -> a -> b
    $ do
        ref <- Body -> STM (TVar Body)
    forall a. a -> STM (TVar a)
    TVar.newTVar Body
    Empty
        pure $ Region ref

    newOpenRegion :: LiftRegion m => m Region
    newOpenRegion :: forall (m :: * -> *). LiftRegion m => m Region
    newOpenRegion =
      STM Region -> m Region
    forall a. STM a -> m a
    forall (m :: * -> *) a. LiftRegion m => STM a -> m a
    liftRegion (STM Region -> m Region) -> STM Region -> m Region
    forall a b. (a -> b) -> a -> b
    $ do
        region <- RegionLayout -> STM ConsoleRegion
    forall (m :: * -> *).
    LiftRegion m =>
    RegionLayout -> m ConsoleRegion
    Console.openConsoleRegion RegionLayout
    Linear
        ref <- TVar.newTVar $ Open region
        pure $ Region ref

    openRegion :: LiftRegion m => Region -> String -> m ()
    openRegion :: forall (m :: * -> *). LiftRegion m => Region -> String -> m ()
    openRegion (Region TVar Body
    var) String
    content =
      STM () -> m ()
    forall a. STM a -> m a
    forall (m :: * -> *) a. LiftRegion m => STM a -> m a
    liftRegion (STM () -> m ()) -> STM () -> m ()
    forall a b. (a -> b) -> a -> b
    $ do
        body <- TVar Body -> STM Body
    forall a. TVar a -> STM a
    TVar.readTVar TVar Body
    var
        case body of
          Body
    Empty -> do
            region <- RegionLayout -> STM ConsoleRegion
    forall (m :: * -> *).
    LiftRegion m =>
    RegionLayout -> m ConsoleRegion
    Console.openConsoleRegion RegionLayout
    Linear
            TVar.writeTVar var $ Open region
            Console.setConsoleRegion region content

          Open ConsoleRegion
    region ->
            ConsoleRegion -> String -> STM ()
    forall v (m :: * -> *).
    (ToRegionContent v, LiftRegion m) =>
    ConsoleRegion -> v -> m ()
    Console.setConsoleRegion ConsoleRegion
    region String
    content

          Body
    Closed ->
            () -> STM ()
    forall a. a -> STM a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure ()

    setRegion :: LiftRegion m => Region -> String -> m ()
    setRegion :: forall (m :: * -> *). LiftRegion m => Region -> String -> m ()
    setRegion (Region TVar Body
    var) String
    content =
      STM () -> m ()
    forall a. STM a -> m a
    forall (m :: * -> *) a. LiftRegion m => STM a -> m a
    liftRegion (STM () -> m ()) -> STM () -> m ()
    forall a b. (a -> b) -> a -> b
    $ do
        body <- TVar Body -> STM Body
    forall a. TVar a -> STM a
    TVar.readTVar TVar Body
    var
        case body of
          Body
    Empty ->
            () -> STM ()
    forall a. a -> STM a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure ()

          Open ConsoleRegion
    region ->
            ConsoleRegion -> String -> STM ()
    forall v (m :: * -> *).
    (ToRegionContent v, LiftRegion m) =>
    ConsoleRegion -> v -> m ()
    Console.setConsoleRegion ConsoleRegion
    region String
    content

          Body
    Closed ->
            () -> STM ()
    forall a. a -> STM a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure ()

    displayRegions :: (MonadIO m, MonadMask m) => m a -> m a
    displayRegions :: forall (m :: * -> *) a. (MonadIO m, MonadMask m) => m a -> m a
    displayRegions m a
    io =
      m a -> m a
    forall (m :: * -> *) a. (MonadIO m, MonadMask m) => m a -> m a
    Console.displayConsoleRegions m a
    io

    displayRegion ::
         MonadIO m
      => MonadMask m
      => LiftRegion m
      => (Region -> m a)
      -> m a
    displayRegion :: forall (m :: * -> *) a.
    (MonadIO m, MonadMask m, LiftRegion m) =>
    (Region -> m a) -> m a
    displayRegion =
      m a -> m a
    forall (m :: * -> *) a. (MonadIO m, MonadMask m) => m a -> m a
    displayRegions (m a -> m a) -> ((Region -> m a) -> m a) -> (Region -> m a) -> m a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . m Region -> (Region -> m ()) -> (Region -> m a) -> m a
    forall (m :: * -> *) a b c.
    (HasCallStack, MonadMask m) =>
    m a -> (a -> m b) -> (a -> m c) -> m c
    bracket m Region
    forall (m :: * -> *). LiftRegion m => m Region
    newOpenRegion Region -> m ()
    forall (m :: * -> *). LiftRegion m => Region -> m ()
    finishRegion

    moveToBottom :: Region -> STM ()
    moveToBottom :: Region -> STM ()
    moveToBottom (Region TVar Body
    var) =
      STM () -> STM ()
    forall a. STM a -> STM a
    forall (m :: * -> *) a. LiftRegion m => STM a -> m a
    liftRegion (STM () -> STM ()) -> STM () -> STM ()
    forall a b. (a -> b) -> a -> b
    $ do
        body <- TVar Body -> STM Body
    forall a. TVar a -> STM a
    TVar.readTVar TVar Body
    var
        case body of
          Body
    Empty ->
            () -> STM ()
    forall a. a -> STM a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure ()

          Open ConsoleRegion
    region -> do
            mxs <- TMVar [ConsoleRegion] -> STM (Maybe [ConsoleRegion])
    forall a. TMVar a -> STM (Maybe a)
    TMVar.tryTakeTMVar TMVar [ConsoleRegion]
    Console.regionList
            case mxs of
              Maybe [ConsoleRegion]
    Nothing ->
                () -> STM ()
    forall a. a -> STM a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure ()

              Just [ConsoleRegion]
    xs0 ->
                let
                  xs1 :: [ConsoleRegion]
    xs1 =
                    (ConsoleRegion -> Bool) -> [ConsoleRegion] -> [ConsoleRegion]
    forall a. (a -> Bool) -> [a] -> [a]
    filter (ConsoleRegion -> ConsoleRegion -> Bool
    forall a. Eq a => a -> a -> Bool
    /= ConsoleRegion
    region) [ConsoleRegion]
    xs0
                in
                  TMVar [ConsoleRegion] -> [ConsoleRegion] -> STM ()
    forall a. TMVar a -> a -> STM ()
    TMVar.putTMVar TMVar [ConsoleRegion]
    Console.regionList (ConsoleRegion
    region ConsoleRegion -> [ConsoleRegion] -> [ConsoleRegion]
    forall a. a -> [a] -> [a]
    : [ConsoleRegion]
    xs1)

          Body
    Closed ->
            () -> STM ()
    forall a. a -> STM a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure ()

    finishRegion :: LiftRegion m => Region -> m ()
    finishRegion :: forall (m :: * -> *). LiftRegion m => Region -> m ()
    finishRegion (Region TVar Body
    var) =
      STM () -> m ()
    forall a. STM a -> m a
    forall (m :: * -> *) a. LiftRegion m => STM a -> m a
    liftRegion (STM () -> m ()) -> STM () -> m ()
    forall a b. (a -> b) -> a -> b
    $ do
        body <- TVar Body -> STM Body
    forall a. TVar a -> STM a
    TVar.readTVar TVar Body
    var
        case body of
          Body
    Empty -> do
            TVar Body -> Body -> STM ()
    forall a. TVar a -> a -> STM ()
    TVar.writeTVar TVar Body
    var Body
    Closed

          Open ConsoleRegion
    region -> do
            content <- ConsoleRegion -> STM Text
    forall (m :: * -> *). LiftRegion m => ConsoleRegion -> m Text
    Console.getConsoleRegion ConsoleRegion
    region
            Console.finishConsoleRegion region content
            TVar.writeTVar var Closed

          Body
    Closed ->
            () -> STM ()
    forall a. a -> STM a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure ()