{-# LANGUAGE CPP #-}
{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE ScopedTypeVariables #-}

-- Copyright (c) 2005-2011 Stefan Wehr - http://www.stefanwehr.de
--
-- This library is free software; you can redistribute it and/or
-- modify it under the terms of the GNU Lesser General Public
-- License as published by the Free Software Foundation; either
-- version 2.1 of the License, or (at your option) any later version.
--
-- This library is distributed in the hope that it will be useful,
-- but WITHOUT ANY WARRANTY; without even the implied warranty of
-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
-- Lesser General Public License for more details.
--
-- You should have received a copy of the GNU Lesser General Public
-- License along with this library; if not, write to the Free Software
-- Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301  USA

module UI.HSCurses.Widgets where

import Control.Exception (assert)
#if MIN_VERSION_exceptions(0,6,0)
import Control.Monad.Catch (MonadMask)
#else
import Control.Monad.Catch (MonadCatch)
#define MonadMask MonadCatch
#endif
import Control.Monad.Trans
import Data.Char
import Data.List
import Data.List.NonEmpty (NonEmpty ((:|)))
import qualified Data.List.NonEmpty as NonEmpty
import Data.Maybe

import qualified UI.HSCurses.Curses as Curses
import qualified UI.HSCurses.CursesHelper as CursesH
import UI.HSCurses.Logging

type Pos = (Int, Int)
type Offset = (Int, Int)

type Size =
    ( Int -- height
    , Int -- width
    )

getHeight :: Size -> Int
getHeight :: Size -> Int
getHeight = Size -> Int
forall a b. (a, b) -> a
fst

getWidth :: Size -> Int
getWidth :: Size -> Int
getWidth = Size -> Int
forall a b. (a, b) -> b
snd

getYOffset :: Offset -> Int
getYOffset :: Size -> Int
getYOffset = Size -> Int
forall a b. (a, b) -> a
fst

getXOffset :: Offset -> Int
getXOffset :: Size -> Int
getXOffset = Size -> Int
forall a b. (a, b) -> b
snd

getYPos :: Pos -> Int
getYPos :: Size -> Int
getYPos = Size -> Int
forall a b. (a, b) -> a
fst

getXPos :: Pos -> Int
getXPos :: Size -> Int
getXPos = Size -> Int
forall a b. (a, b) -> b
snd

data Direction = DirLeft | DirRight | DirUp | DirDown
    deriving (Direction -> Direction -> Bool
(Direction -> Direction -> Bool)
-> (Direction -> Direction -> Bool) -> Eq Direction
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Direction -> Direction -> Bool
== :: Direction -> Direction -> Bool
$c/= :: Direction -> Direction -> Bool
/= :: Direction -> Direction -> Bool
Eq, Int -> Direction -> ShowS
[Direction] -> ShowS
Direction -> String
(Int -> Direction -> ShowS)
-> (Direction -> String)
-> ([Direction] -> ShowS)
-> Show Direction
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Direction -> ShowS
showsPrec :: Int -> Direction -> ShowS
$cshow :: Direction -> String
show :: Direction -> String
$cshowList :: [Direction] -> ShowS
showList :: [Direction] -> ShowS
Show, Eq Direction
Eq Direction =>
(Direction -> Direction -> Ordering)
-> (Direction -> Direction -> Bool)
-> (Direction -> Direction -> Bool)
-> (Direction -> Direction -> Bool)
-> (Direction -> Direction -> Bool)
-> (Direction -> Direction -> Direction)
-> (Direction -> Direction -> Direction)
-> Ord Direction
Direction -> Direction -> Bool
Direction -> Direction -> Ordering
Direction -> Direction -> Direction
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Direction -> Direction -> Ordering
compare :: Direction -> Direction -> Ordering
$c< :: Direction -> Direction -> Bool
< :: Direction -> Direction -> Bool
$c<= :: Direction -> Direction -> Bool
<= :: Direction -> Direction -> Bool
$c> :: Direction -> Direction -> Bool
> :: Direction -> Direction -> Bool
$c>= :: Direction -> Direction -> Bool
>= :: Direction -> Direction -> Bool
$cmax :: Direction -> Direction -> Direction
max :: Direction -> Direction -> Direction
$cmin :: Direction -> Direction -> Direction
min :: Direction -> Direction -> Direction
Ord)

data HAlignment = AlignLeft | AlignCenter | AlignRight
    deriving (HAlignment -> HAlignment -> Bool
(HAlignment -> HAlignment -> Bool)
-> (HAlignment -> HAlignment -> Bool) -> Eq HAlignment
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: HAlignment -> HAlignment -> Bool
== :: HAlignment -> HAlignment -> Bool
$c/= :: HAlignment -> HAlignment -> Bool
/= :: HAlignment -> HAlignment -> Bool
Eq, Int -> HAlignment -> ShowS
[HAlignment] -> ShowS
HAlignment -> String
(Int -> HAlignment -> ShowS)
-> (HAlignment -> String)
-> ([HAlignment] -> ShowS)
-> Show HAlignment
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> HAlignment -> ShowS
showsPrec :: Int -> HAlignment -> ShowS
$cshow :: HAlignment -> String
show :: HAlignment -> String
$cshowList :: [HAlignment] -> ShowS
showList :: [HAlignment] -> ShowS
Show)

data Cont a = Cont a | Done a

class Widget a where
    draw :: Pos -> Size -> DrawingHint -> a -> IO ()
    minSize :: a -> Size

class (Widget a) => ActiveWidget a where
    activate ::
        (MonadIO m, MonadMask m) =>
        m () ->
        Pos ->
        Size ->
        a ->
        m (a, String)

type KeyHandler a = Pos -> Size -> a -> IO (Cont a)

mkKeyHandler ::
    (Pos -> Size -> a -> a) ->
    KeyHandler a
mkKeyHandler :: forall a. (Size -> Size -> a -> a) -> KeyHandler a
mkKeyHandler Size -> Size -> a -> a
f Size
pos Size
sz a
w = Cont a -> IO (Cont a)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> Cont a
forall a. a -> Cont a
Cont (Size -> Size -> a -> a
f Size
pos Size
sz a
w))

--
-- Drawing
--

data DrawingHint
    = DHNormal
    | DHFocus
    | DHActive
    deriving (DrawingHint -> DrawingHint -> Bool
(DrawingHint -> DrawingHint -> Bool)
-> (DrawingHint -> DrawingHint -> Bool) -> Eq DrawingHint
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: DrawingHint -> DrawingHint -> Bool
== :: DrawingHint -> DrawingHint -> Bool
$c/= :: DrawingHint -> DrawingHint -> Bool
/= :: DrawingHint -> DrawingHint -> Bool
Eq, Int -> DrawingHint -> ShowS
[DrawingHint] -> ShowS
DrawingHint -> String
(Int -> DrawingHint -> ShowS)
-> (DrawingHint -> String)
-> ([DrawingHint] -> ShowS)
-> Show DrawingHint
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> DrawingHint -> ShowS
showsPrec :: Int -> DrawingHint -> ShowS
$cshow :: DrawingHint -> String
show :: DrawingHint -> String
$cshowList :: [DrawingHint] -> ShowS
showList :: [DrawingHint] -> ShowS
Show, Eq DrawingHint
Eq DrawingHint =>
(DrawingHint -> DrawingHint -> Ordering)
-> (DrawingHint -> DrawingHint -> Bool)
-> (DrawingHint -> DrawingHint -> Bool)
-> (DrawingHint -> DrawingHint -> Bool)
-> (DrawingHint -> DrawingHint -> Bool)
-> (DrawingHint -> DrawingHint -> DrawingHint)
-> (DrawingHint -> DrawingHint -> DrawingHint)
-> Ord DrawingHint
DrawingHint -> DrawingHint -> Bool
DrawingHint -> DrawingHint -> Ordering
DrawingHint -> DrawingHint -> DrawingHint
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: DrawingHint -> DrawingHint -> Ordering
compare :: DrawingHint -> DrawingHint -> Ordering
$c< :: DrawingHint -> DrawingHint -> Bool
< :: DrawingHint -> DrawingHint -> Bool
$c<= :: DrawingHint -> DrawingHint -> Bool
<= :: DrawingHint -> DrawingHint -> Bool
$c> :: DrawingHint -> DrawingHint -> Bool
> :: DrawingHint -> DrawingHint -> Bool
$c>= :: DrawingHint -> DrawingHint -> Bool
>= :: DrawingHint -> DrawingHint -> Bool
$cmax :: DrawingHint -> DrawingHint -> DrawingHint
max :: DrawingHint -> DrawingHint -> DrawingHint
$cmin :: DrawingHint -> DrawingHint -> DrawingHint
min :: DrawingHint -> DrawingHint -> DrawingHint
Ord)

data DrawingStyle = DStyle
    { DrawingStyle -> CursesStyle
dstyle_normal :: CursesH.CursesStyle
    , DrawingStyle -> CursesStyle
dstyle_focus :: CursesH.CursesStyle
    , DrawingStyle -> CursesStyle
dstyle_active :: CursesH.CursesStyle
    }
    deriving (DrawingStyle -> DrawingStyle -> Bool
(DrawingStyle -> DrawingStyle -> Bool)
-> (DrawingStyle -> DrawingStyle -> Bool) -> Eq DrawingStyle
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: DrawingStyle -> DrawingStyle -> Bool
== :: DrawingStyle -> DrawingStyle -> Bool
$c/= :: DrawingStyle -> DrawingStyle -> Bool
/= :: DrawingStyle -> DrawingStyle -> Bool
Eq, Int -> DrawingStyle -> ShowS
[DrawingStyle] -> ShowS
DrawingStyle -> String
(Int -> DrawingStyle -> ShowS)
-> (DrawingStyle -> String)
-> ([DrawingStyle] -> ShowS)
-> Show DrawingStyle
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> DrawingStyle -> ShowS
showsPrec :: Int -> DrawingStyle -> ShowS
$cshow :: DrawingStyle -> String
show :: DrawingStyle -> String
$cshowList :: [DrawingStyle] -> ShowS
showList :: [DrawingStyle] -> ShowS
Show)

mkDrawingStyle :: CursesH.CursesStyle -> DrawingStyle
mkDrawingStyle :: CursesStyle -> DrawingStyle
mkDrawingStyle CursesStyle
defStyle =
    let revStyle :: CursesStyle
revStyle = CursesStyle -> [Attribute] -> CursesStyle
CursesH.changeCursesStyle CursesStyle
defStyle [Attribute
CursesH.Reverse]
     in DStyle
            { dstyle_normal :: CursesStyle
dstyle_normal = CursesStyle
defStyle
            , dstyle_focus :: CursesStyle
dstyle_focus = CursesStyle
revStyle
            , dstyle_active :: CursesStyle
dstyle_active = CursesStyle
revStyle
            }

defaultDrawingStyle :: DrawingStyle
defaultDrawingStyle :: DrawingStyle
defaultDrawingStyle = CursesStyle -> DrawingStyle
mkDrawingStyle CursesStyle
CursesH.defaultCursesStyle
_draw :: DrawingHint -> DrawingStyle -> IO a -> IO a
_draw :: forall a. DrawingHint -> DrawingStyle -> IO a -> IO a
_draw DrawingHint
DHActive DrawingStyle
sty IO a
io = CursesStyle -> IO a -> IO a
forall (m :: * -> *) a.
(MonadIO m, MonadMask m) =>
CursesStyle -> m a -> m a
CursesH.withStyle (DrawingStyle -> CursesStyle
dstyle_active DrawingStyle
sty) IO a
io
_draw DrawingHint
DHNormal DrawingStyle
sty IO a
io = CursesStyle -> IO a -> IO a
forall (m :: * -> *) a.
(MonadIO m, MonadMask m) =>
CursesStyle -> m a -> m a
CursesH.withStyle (DrawingStyle -> CursesStyle
dstyle_normal DrawingStyle
sty) IO a
io
_draw DrawingHint
DHFocus DrawingStyle
sty IO a
io = CursesStyle -> IO a -> IO a
forall (m :: * -> *) a.
(MonadIO m, MonadMask m) =>
CursesStyle -> m a -> m a
CursesH.withStyle (DrawingStyle -> CursesStyle
dstyle_focus DrawingStyle
sty) IO a
io

--
-- Helper functions for scrolling
--

scrollFactor :: Double
scrollFactor :: Double
scrollFactor = Double
0.8

scrollBy :: Int -> Int
scrollBy :: Int -> Int
scrollBy Int
displayLen =
    let amount :: Int
amount = Double -> Int
forall b. Integral b => Double -> b
forall a b. (RealFrac a, Integral b) => a -> b
floor ((Integer -> Double
forall a. Num a => Integer -> a
fromInteger (Integer -> Double) -> (Int -> Integer) -> Int -> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Integer
forall a. Integral a => a -> Integer
toInteger) Int
displayLen Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
scrollFactor)
     in Int -> Int -> Int
forall a. Ord a => a -> a -> a
max (Int
displayLen Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) (Int -> Int -> Int
forall a. Ord a => a -> a -> a
min Int
1 Int
amount)

-- returns the new offset for scrolling in forward direction
-- dataLen: total number of data items
-- offset: the index of the first data item shown on the current page
-- displayLen: the number of data items that is shown in one page
scrollForward :: Int -> Int -> Int -> Int
scrollForward :: Int -> Int -> Int -> Int
scrollForward Int
dataLen Int
offset Int
displayLen =
    if Int
offset Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
displayLen Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
dataLen
        then Int
offset
        else Int -> Int -> Int
forall a. Ord a => a -> a -> a
min (Int
offset Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int -> Int
scrollBy Int
displayLen) (Int
dataLen Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
displayLen)

-- returns the new offset for scrolling in backward direction.
-- parameters as for scrollForward
scrollBackward :: t -> Int -> Int -> Int
scrollBackward :: forall t. t -> Int -> Int -> Int
scrollBackward t
_ Int
offset Int
displayLen =
    if Int
offset Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0
        then Int
offset
        else Int -> Int -> Int
forall a. Ord a => a -> a -> a
max (Int
offset Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int -> Int
scrollBy Int
displayLen) Int
0

--
-- EmptyWidget
--

data EmptyWidget = EmptyWidget Size

instance Widget EmptyWidget where
    draw :: Size -> Size -> DrawingHint -> EmptyWidget -> IO ()
draw Size
_ Size
_ DrawingHint
_ EmptyWidget
_ = () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    minSize :: EmptyWidget -> Size
minSize (EmptyWidget Size
sz) = Size
sz

--
-- An opaque widget
--

data OpaqueWidget = OpaqueWidget Size

instance Widget OpaqueWidget where
    draw :: Size -> Size -> DrawingHint -> OpaqueWidget -> IO ()
draw (Int
y, Int
x) (Int
h, Int
w) DrawingHint
_ OpaqueWidget
_ =
        let draw' :: Int -> IO ()
draw' Int
n =
                do
                    Window -> Int -> Int -> IO ()
Curses.wMove Window
Curses.stdScr (Int
y Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
n) Int
x
                    Int -> String -> IO ()
CursesH.drawLine Int
w String
""
         in do
                (Int -> IO ()) -> [Int] -> IO [()]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM Int -> IO ()
draw' (Int -> [Int] -> [Int]
forall a. Int -> [a] -> [a]
take Int
h [Int
0 ..])
                IO ()
Curses.refresh
    minSize :: OpaqueWidget -> Size
minSize (OpaqueWidget Size
sz) = Size
sz

--
-- Widget for text input
--

data EditWidget = EditWidget
    { EditWidget -> String
ew_content :: String
    , EditWidget -> Int
ew_xoffset :: Int -- content!!xoffset is the 1st char shown
    , EditWidget -> Int
ew_xcursor :: Int -- cursor position
    , EditWidget -> [String]
ew_history :: [String]
    , EditWidget -> Int
ew_historyIndex :: Int
    , EditWidget -> Maybe String
ew_historySavedContent :: Maybe String
    , EditWidget -> EditWidgetOptions
ew_options :: EditWidgetOptions
    }

ew_contentPos :: EditWidget -> Int
ew_contentPos :: EditWidget -> Int
ew_contentPos EditWidget
ew = EditWidget -> Int
ew_xcursor EditWidget
ew Int -> Int -> Int
forall a. Num a => a -> a -> a
+ EditWidget -> Int
ew_xoffset EditWidget
ew

instance Widget EditWidget where
    draw :: Size -> Size -> DrawingHint -> EditWidget -> IO ()
draw = Size -> Size -> DrawingHint -> EditWidget -> IO ()
drawEditWidget
    minSize :: EditWidget -> Size
minSize EditWidget
ew = (Int
1, EditWidgetOptions -> Int
ewopt_minWidth (EditWidgetOptions -> Int) -> EditWidgetOptions -> Int
forall a b. (a -> b) -> a -> b
$ EditWidget -> EditWidgetOptions
ew_options EditWidget
ew)

instance ActiveWidget EditWidget where
    activate :: forall (m :: * -> *).
(MonadIO m, MonadMask m) =>
m () -> Size -> Size -> EditWidget -> m (EditWidget, String)
activate = m () -> Size -> Size -> EditWidget -> m (EditWidget, String)
forall (m :: * -> *).
(MonadIO m, MonadMask m) =>
m () -> Size -> Size -> EditWidget -> m (EditWidget, String)
activateEditWidget

data EditWidgetOptions = EWOptions
    { EditWidgetOptions -> [(Key, KeyHandler EditWidget)]
ewopt_keyHandlers :: [(Curses.Key, KeyHandler EditWidget)]
    , EditWidgetOptions -> Int
ewopt_minWidth :: Int
    , EditWidgetOptions -> DrawingStyle
ewopt_style :: DrawingStyle
    }

defaultEWOptions :: EditWidgetOptions
defaultEWOptions :: EditWidgetOptions
defaultEWOptions =
    EWOptions
        { ewopt_keyHandlers :: [(Key, KeyHandler EditWidget)]
ewopt_keyHandlers = [(Key, KeyHandler EditWidget)]
editWidgetKeyHandlers
        , ewopt_minWidth :: Int
ewopt_minWidth = Int
8
        , ewopt_style :: DrawingStyle
ewopt_style = DrawingStyle
defaultDrawingStyle
        }

newEditWidget :: EditWidgetOptions -> String -> EditWidget
newEditWidget :: EditWidgetOptions -> String -> EditWidget
newEditWidget EditWidgetOptions
opts =
    EditWidget -> String -> EditWidget
editWidgetSetContent
        ( EditWidget
            { ew_content :: String
ew_content = String
""
            , ew_xoffset :: Int
ew_xoffset = Int
0
            , ew_xcursor :: Int
ew_xcursor = Int
0
            , ew_history :: [String]
ew_history = []
            , ew_historyIndex :: Int
ew_historyIndex = -Int
1
            , ew_historySavedContent :: Maybe String
ew_historySavedContent = Maybe String
forall a. Maybe a
Nothing
            , ew_options :: EditWidgetOptions
ew_options = EditWidgetOptions
opts
            }
        )

editWidgetGoLeft ::
    Pos ->
    Size ->
    EditWidget ->
    IO (Cont EditWidget)
editWidgetGoLeft :: KeyHandler EditWidget
editWidgetGoLeft = (Size -> Size -> EditWidget -> EditWidget) -> KeyHandler EditWidget
forall a. (Size -> Size -> a -> a) -> KeyHandler a
mkKeyHandler Size -> Size -> EditWidget -> EditWidget
forall t t1. t -> t1 -> EditWidget -> EditWidget
editWidgetGoLeft'
editWidgetGoRight ::
    Pos ->
    Size ->
    EditWidget ->
    IO (Cont EditWidget)
editWidgetGoRight :: KeyHandler EditWidget
editWidgetGoRight = (Size -> Size -> EditWidget -> EditWidget) -> KeyHandler EditWidget
forall a. (Size -> Size -> a -> a) -> KeyHandler a
mkKeyHandler Size -> Size -> EditWidget -> EditWidget
forall t t1. t -> (t1, Int) -> EditWidget -> EditWidget
editWidgetGoRight'
editWidgetDeleteLeft ::
    Pos ->
    Size ->
    EditWidget ->
    IO (Cont EditWidget)
editWidgetDeleteLeft :: KeyHandler EditWidget
editWidgetDeleteLeft = (Size -> Size -> EditWidget -> EditWidget) -> KeyHandler EditWidget
forall a. (Size -> Size -> a -> a) -> KeyHandler a
mkKeyHandler Size -> Size -> EditWidget -> EditWidget
editWidgetDeleteLeft'
editWidgetDeleteUnderCursor ::
    Pos ->
    Size ->
    EditWidget ->
    IO (Cont EditWidget)
editWidgetDeleteUnderCursor :: KeyHandler EditWidget
editWidgetDeleteUnderCursor = (Size -> Size -> EditWidget -> EditWidget) -> KeyHandler EditWidget
forall a. (Size -> Size -> a -> a) -> KeyHandler a
mkKeyHandler Size -> Size -> EditWidget -> EditWidget
forall t t1. t -> t1 -> EditWidget -> EditWidget
editWidgetDeleteUnderCursor'
editWidgetDeleteToEnd ::
    Pos ->
    Size ->
    EditWidget ->
    IO (Cont EditWidget)
editWidgetDeleteToEnd :: KeyHandler EditWidget
editWidgetDeleteToEnd = (Size -> Size -> EditWidget -> EditWidget) -> KeyHandler EditWidget
forall a. (Size -> Size -> a -> a) -> KeyHandler a
mkKeyHandler Size -> Size -> EditWidget -> EditWidget
forall t t1. t -> t1 -> EditWidget -> EditWidget
editWidgetDeleteToEnd'
editWidgetGoHome ::
    Pos ->
    Size ->
    EditWidget ->
    IO (Cont EditWidget)
editWidgetGoHome :: KeyHandler EditWidget
editWidgetGoHome = (Size -> Size -> EditWidget -> EditWidget) -> KeyHandler EditWidget
forall a. (Size -> Size -> a -> a) -> KeyHandler a
mkKeyHandler Size -> Size -> EditWidget -> EditWidget
forall t t1. t -> t1 -> EditWidget -> EditWidget
editWidgetGoHome'
editWidgetGoEnd ::
    Pos ->
    Size ->
    EditWidget ->
    IO (Cont EditWidget)
editWidgetGoEnd :: KeyHandler EditWidget
editWidgetGoEnd = (Size -> Size -> EditWidget -> EditWidget) -> KeyHandler EditWidget
forall a. (Size -> Size -> a -> a) -> KeyHandler a
mkKeyHandler Size -> Size -> EditWidget -> EditWidget
editWidgetGoEnd'
editWidgetHistoryUp ::
    Pos ->
    Size ->
    EditWidget ->
    IO (Cont EditWidget)
editWidgetHistoryUp :: KeyHandler EditWidget
editWidgetHistoryUp = (Size -> Size -> EditWidget -> EditWidget) -> KeyHandler EditWidget
forall a. (Size -> Size -> a -> a) -> KeyHandler a
mkKeyHandler Size -> Size -> EditWidget -> EditWidget
forall t t1. t -> t1 -> EditWidget -> EditWidget
editWidgetHistoryUp'
editWidgetHistoryDown ::
    Pos ->
    Size ->
    EditWidget ->
    IO (Cont EditWidget)
editWidgetHistoryDown :: KeyHandler EditWidget
editWidgetHistoryDown = (Size -> Size -> EditWidget -> EditWidget) -> KeyHandler EditWidget
forall a. (Size -> Size -> a -> a) -> KeyHandler a
mkKeyHandler Size -> Size -> EditWidget -> EditWidget
forall t t1. t -> t1 -> EditWidget -> EditWidget
editWidgetHistoryDown'

editWidgetKeyHandlers ::
    [ ( Curses.Key
      , Pos ->
        Size ->
        EditWidget ->
        IO (Cont EditWidget)
      )
    ]
editWidgetKeyHandlers :: [(Key, KeyHandler EditWidget)]
editWidgetKeyHandlers =
    [ (Key
Curses.KeyLeft, KeyHandler EditWidget
editWidgetGoLeft)
    , (Key
Curses.KeyRight, KeyHandler EditWidget
editWidgetGoRight)
    , (Key
Curses.KeyBackspace, KeyHandler EditWidget
editWidgetDeleteLeft)
    , (Char -> Key
Curses.KeyChar Char
'\^D', KeyHandler EditWidget
editWidgetDeleteUnderCursor)
    , (Key
Curses.KeyDC, KeyHandler EditWidget
editWidgetDeleteUnderCursor)
    , (Char -> Key
Curses.KeyChar Char
'\^K', KeyHandler EditWidget
editWidgetDeleteToEnd)
    , (Key
Curses.KeyHome, KeyHandler EditWidget
editWidgetGoHome)
    , (Char -> Key
Curses.KeyChar Char
'\^A', KeyHandler EditWidget
editWidgetGoHome)
    , (Key
Curses.KeyEnd, KeyHandler EditWidget
editWidgetGoEnd)
    , (Char -> Key
Curses.KeyChar Char
'\^E', KeyHandler EditWidget
editWidgetGoEnd)
    , (Char -> Key
Curses.KeyChar Char
'\r', KeyHandler EditWidget
forall (m :: * -> *) t t1.
Monad m =>
t -> t1 -> EditWidget -> m (Cont EditWidget)
editWidgetFinish)
    , (Char -> Key
Curses.KeyChar Char
'\t', KeyHandler EditWidget
forall (m :: * -> *) t t1.
Monad m =>
t -> t1 -> EditWidget -> m (Cont EditWidget)
editWidgetFinish)
    , (Key
Curses.KeyUp, KeyHandler EditWidget
editWidgetHistoryUp)
    , (Key
Curses.KeyDown, KeyHandler EditWidget
editWidgetHistoryDown)
    ]

editWidgetGetContent :: EditWidget -> String
editWidgetGetContent :: EditWidget -> String
editWidgetGetContent EditWidget
ew = EditWidget -> String
ew_content EditWidget
ew
editWidgetSetContent ::
    EditWidget ->
    String ->
    EditWidget
editWidgetSetContent :: EditWidget -> String -> EditWidget
editWidgetSetContent EditWidget
ew String
s =
    EditWidget -> String -> EditWidget
addToHistory (EditWidget
ew {ew_content = s, ew_xoffset = 0, ew_xcursor = 0}) String
s

editWidgetGetOptions ::
    EditWidget ->
    EditWidgetOptions
editWidgetGetOptions :: EditWidget -> EditWidgetOptions
editWidgetGetOptions EditWidget
ew = EditWidget -> EditWidgetOptions
ew_options EditWidget
ew
editWidgetSetOptions ::
    EditWidget ->
    EditWidgetOptions ->
    EditWidget
editWidgetSetOptions :: EditWidget -> EditWidgetOptions -> EditWidget
editWidgetSetOptions EditWidget
ew EditWidgetOptions
opts = EditWidget
ew {ew_options = opts}

drawEditWidget :: Pos -> Size -> DrawingHint -> EditWidget -> IO ()
drawEditWidget :: Size -> Size -> DrawingHint -> EditWidget -> IO ()
drawEditWidget (Int
y, Int
x) (Int
_, Int
width) DrawingHint
hint EditWidget
ew =
    DrawingHint -> DrawingStyle -> IO () -> IO ()
forall a. DrawingHint -> DrawingStyle -> IO a -> IO a
_draw DrawingHint
hint (EditWidgetOptions -> DrawingStyle
ewopt_style (EditWidgetOptions -> DrawingStyle)
-> (EditWidget -> EditWidgetOptions) -> EditWidget -> DrawingStyle
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EditWidget -> EditWidgetOptions
ew_options (EditWidget -> DrawingStyle) -> EditWidget -> DrawingStyle
forall a b. (a -> b) -> a -> b
$ EditWidget
ew) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
        do
            Window -> Int -> Int -> IO ()
Curses.wMove Window
Curses.stdScr Int
y Int
x
            Int -> String -> IO ()
CursesH.drawLine Int
width (Int -> ShowS
forall a. Int -> [a] -> [a]
drop (EditWidget -> Int
ew_xoffset EditWidget
ew) ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ EditWidget -> String
ew_content EditWidget
ew)
            IO ()
Curses.refresh

activateEditWidget ::
    (MonadIO m, MonadMask m) =>
    m () ->
    Pos ->
    Size ->
    EditWidget ->
    m (EditWidget, String)
activateEditWidget :: forall (m :: * -> *).
(MonadIO m, MonadMask m) =>
m () -> Size -> Size -> EditWidget -> m (EditWidget, String)
activateEditWidget m ()
refresh pos :: Size
pos@(Int
y, Int
x) sz :: Size
sz@(Int
_, Int
width) EditWidget
ew =
    CursorVisibility
-> m (EditWidget, String) -> m (EditWidget, String)
forall (m :: * -> *) a.
(MonadIO m, MonadMask m) =>
CursorVisibility -> m a -> m a
CursesH.withCursor CursorVisibility
Curses.CursorVisible (m (EditWidget, String) -> m (EditWidget, String))
-> m (EditWidget, String) -> m (EditWidget, String)
forall a b. (a -> b) -> a -> b
$ EditWidget -> m (EditWidget, String)
processKey EditWidget
ew
  where
    processKey :: EditWidget -> m (EditWidget, String)
processKey EditWidget
ex =
        do
            IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ EditWidget -> IO ()
drawLocal EditWidget
ex
            k <- m () -> m Key
forall (m :: * -> *). MonadIO m => m () -> m Key
CursesH.getKey m ()
refresh
            case lookup k (ewopt_keyHandlers $ ew_options ex) of
                Maybe (KeyHandler EditWidget)
Nothing ->
                    case Key
k of
                        Curses.KeyChar Char
c
                            | Char -> Bool
isAscii Char
c Bool -> Bool -> Bool
&& Char -> Bool
isPrint Char
c ->
                                EditWidget -> m (EditWidget, String)
processKey (EditWidget -> m (EditWidget, String))
-> EditWidget -> m (EditWidget, String)
forall a b. (a -> b) -> a -> b
$ EditWidget -> Char -> EditWidget
insertChar EditWidget
ex Char
c
                        Key
_ -> EditWidget -> m (EditWidget, String)
processKey EditWidget
ex
                Just KeyHandler EditWidget
f ->
                    do
                        x' <- IO (Cont EditWidget) -> m (Cont EditWidget)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Cont EditWidget) -> m (Cont EditWidget))
-> IO (Cont EditWidget) -> m (Cont EditWidget)
forall a b. (a -> b) -> a -> b
$ KeyHandler EditWidget
f Size
pos Size
sz EditWidget
ex
                        case x' of
                            Cont EditWidget
ex' -> EditWidget -> m (EditWidget, String)
processKey EditWidget
ex'
                            Done EditWidget
ex' -> do
                                IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Size -> Size -> DrawingHint -> EditWidget -> IO ()
drawEditWidget Size
pos Size
sz DrawingHint
DHActive EditWidget
ex'
                                (EditWidget, String) -> m (EditWidget, String)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (EditWidget
ex', EditWidget -> String
editWidgetGetContent EditWidget
ex')
    insertChar :: EditWidget -> Char -> EditWidget
insertChar EditWidget
ew' Char
c =
        let pos' :: Int
pos' = EditWidget -> Int
ew_contentPos EditWidget
ew'
            oldContent :: String
oldContent = EditWidget -> String
ew_content EditWidget
ew'
            newContent :: String
newContent = Int -> ShowS
forall a. Int -> [a] -> [a]
take Int
pos' String
oldContent String -> ShowS
forall a. [a] -> [a] -> [a]
++ (Char
c Char -> ShowS
forall a. a -> [a] -> [a]
: Int -> ShowS
forall a. Int -> [a] -> [a]
drop Int
pos' String
oldContent)
         in Int -> Size -> EditWidget -> EditWidget
forall t t1. t -> (t1, Int) -> EditWidget -> EditWidget
editWidgetGoRight' Int
pos' Size
sz (EditWidget
ew' {ew_content = newContent})
    drawLocal :: EditWidget -> IO ()
drawLocal EditWidget
ew' = DrawingHint -> DrawingStyle -> IO () -> IO ()
forall a. DrawingHint -> DrawingStyle -> IO a -> IO a
_draw DrawingHint
DHActive (EditWidgetOptions -> DrawingStyle
ewopt_style (EditWidgetOptions -> DrawingStyle)
-> (EditWidget -> EditWidgetOptions) -> EditWidget -> DrawingStyle
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EditWidget -> EditWidgetOptions
ew_options (EditWidget -> DrawingStyle) -> EditWidget -> DrawingStyle
forall a b. (a -> b) -> a -> b
$ EditWidget
ew') (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
        do
            Window -> Int -> Int -> IO ()
Curses.wMove Window
Curses.stdScr Int
y Int
x
            Int -> String -> IO ()
CursesH.drawLine Int
width (Int -> ShowS
forall a. Int -> [a] -> [a]
drop (EditWidget -> Int
ew_xoffset EditWidget
ew') ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ EditWidget -> String
ew_content EditWidget
ew')
            Window -> Int -> Int -> IO ()
Curses.wMove Window
Curses.stdScr Int
y (Int
x Int -> Int -> Int
forall a. Num a => a -> a -> a
+ EditWidget -> Int
ew_xcursor EditWidget
ew')
            IO ()
Curses.refresh

editWidgetGoLeft' :: t -> t1 -> EditWidget -> EditWidget
editWidgetGoLeft' :: forall t t1. t -> t1 -> EditWidget -> EditWidget
editWidgetGoLeft' t
_ t1
_ EditWidget
ew =
    let newXcursor :: Int
newXcursor = Int -> Int -> Int
forall a. Ord a => a -> a -> a
max (EditWidget -> Int
ew_xcursor EditWidget
ew Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Int
0
        newXoffset :: Int
newXoffset =
            if EditWidget -> Int
ew_xcursor EditWidget
ew Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0
                then Int -> Int -> Int
forall a. Ord a => a -> a -> a
max (EditWidget -> Int
ew_xoffset EditWidget
ew Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Int
0
                else EditWidget -> Int
ew_xoffset EditWidget
ew
     in EditWidget
ew
            { ew_xoffset = newXoffset
            , ew_xcursor = newXcursor
            }

editWidgetGoRight' :: t -> (t1, Int) -> EditWidget -> EditWidget
editWidgetGoRight' :: forall t t1. t -> (t1, Int) -> EditWidget -> EditWidget
editWidgetGoRight' t
_ (t1
_, Int
width) EditWidget
ew =
    let len :: Int
len = String -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (EditWidget -> String
ew_content EditWidget
ew)
        lastChar :: Int
lastChar = Int
len Int -> Int -> Int
forall a. Num a => a -> a -> a
- EditWidget -> Int
ew_xoffset EditWidget
ew Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1
        newXcursor :: Int
newXcursor = [Int] -> Int
forall a. Ord a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
minimum [EditWidget -> Int
ew_xcursor EditWidget
ew Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1, Int
lastChar Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1, Int
width Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1]
        newXoffset :: Int
newXoffset =
            if EditWidget -> Int
ew_xcursor EditWidget
ew Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
width Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1
                then Int -> Int -> Int
forall a. Ord a => a -> a -> a
min (EditWidget -> Int
ew_xoffset EditWidget
ew Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) (Int
len Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
width Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
                else EditWidget -> Int
ew_xoffset EditWidget
ew
     in EditWidget
ew
            { ew_xoffset = newXoffset
            , ew_xcursor = newXcursor
            }

editWidgetDeleteLeft' :: Pos -> Size -> EditWidget -> EditWidget
editWidgetDeleteLeft' :: Size -> Size -> EditWidget -> EditWidget
editWidgetDeleteLeft' Size
pos Size
sz EditWidget
ew =
    let cpos :: Int
cpos = EditWidget -> Int
ew_contentPos EditWidget
ew Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1
        oldContent :: String
oldContent = EditWidget -> String
ew_content EditWidget
ew
        newContent :: String
newContent = Int -> ShowS
forall a. Int -> [a] -> [a]
take Int
cpos String
oldContent String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> ShowS
forall a. Int -> [a] -> [a]
drop (Int
cpos Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) String
oldContent
        ew' :: EditWidget
ew' = Size -> Size -> EditWidget -> EditWidget
forall t t1. t -> t1 -> EditWidget -> EditWidget
editWidgetGoLeft' Size
pos Size
sz (EditWidget
ew {ew_content = newContent})
     in if EditWidget -> Int
ew_xcursor EditWidget
ew Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 Bool -> Bool -> Bool
&& EditWidget -> Int
ew_xoffset EditWidget
ew Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
0
            then Size -> Size -> EditWidget -> EditWidget
forall t t1. t -> (t1, Int) -> EditWidget -> EditWidget
editWidgetGoRight' Size
pos Size
sz (Size -> Size -> EditWidget -> EditWidget
forall t t1. t -> t1 -> EditWidget -> EditWidget
editWidgetGoLeft' Size
pos Size
sz EditWidget
ew')
            else EditWidget
ew'

editWidgetDeleteUnderCursor' :: t -> t1 -> EditWidget -> EditWidget
editWidgetDeleteUnderCursor' :: forall t t1. t -> t1 -> EditWidget -> EditWidget
editWidgetDeleteUnderCursor' t
_ t1
_ EditWidget
ew =
    let pos :: Int
pos = EditWidget -> Int
ew_contentPos EditWidget
ew
        oldContent :: String
oldContent = EditWidget -> String
ew_content EditWidget
ew
        newContent :: String
newContent = Int -> ShowS
forall a. Int -> [a] -> [a]
take Int
pos String
oldContent String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> ShowS
forall a. Int -> [a] -> [a]
drop (Int
pos Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) String
oldContent
     in EditWidget
ew {ew_content = newContent}

editWidgetDeleteToEnd' :: t -> t1 -> EditWidget -> EditWidget
editWidgetDeleteToEnd' :: forall t t1. t -> t1 -> EditWidget -> EditWidget
editWidgetDeleteToEnd' t
_ t1
_ EditWidget
ew =
    let pos :: Int
pos = EditWidget -> Int
ew_contentPos EditWidget
ew
        oldContent :: String
oldContent = EditWidget -> String
ew_content EditWidget
ew
        newContent :: String
newContent = Int -> ShowS
forall a. Int -> [a] -> [a]
take Int
pos String
oldContent
     in EditWidget
ew {ew_content = newContent}

editWidgetGoHome' :: t -> t1 -> EditWidget -> EditWidget
editWidgetGoHome' :: forall t t1. t -> t1 -> EditWidget -> EditWidget
editWidgetGoHome' t
_ t1
_ EditWidget
ew =
    EditWidget
ew
        { ew_xcursor = 0
        , ew_xoffset = 0
        }

editWidgetGoEnd' :: Pos -> Size -> EditWidget -> EditWidget
editWidgetGoEnd' :: Size -> Size -> EditWidget -> EditWidget
editWidgetGoEnd' Size
pos Size
sz EditWidget
ew =
    let cpos :: Int
cpos = EditWidget -> Int
ew_contentPos EditWidget
ew
        len :: Int
len = String -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (EditWidget -> String
ew_content EditWidget
ew)
     in if Int
cpos Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
len
            then EditWidget
ew
            else Size -> Size -> EditWidget -> EditWidget
editWidgetGoEnd' Size
pos Size
sz (Size -> Size -> EditWidget -> EditWidget
forall t t1. t -> (t1, Int) -> EditWidget -> EditWidget
editWidgetGoRight' Size
pos Size
sz EditWidget
ew)

editWidgetFinish :: (Monad m) => t -> t1 -> EditWidget -> m (Cont EditWidget)
editWidgetFinish :: forall (m :: * -> *) t t1.
Monad m =>
t -> t1 -> EditWidget -> m (Cont EditWidget)
editWidgetFinish t
_ t1
_ EditWidget
ew = Cont EditWidget -> m (Cont EditWidget)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (EditWidget -> Cont EditWidget
forall a. a -> Cont a
Done (EditWidget -> String -> EditWidget
addToHistory EditWidget
ew (EditWidget -> String
ew_content EditWidget
ew)))

maxHistoryLength :: Int
maxHistoryLength :: Int
maxHistoryLength = Int
50

addToHistory :: EditWidget -> [Char] -> EditWidget
addToHistory :: EditWidget -> String -> EditWidget
addToHistory EditWidget
ew String
s =
    let newHist :: [String]
newHist =
            if Bool -> Bool
not (String -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
s)
                then Int -> [String] -> [String]
forall a. Int -> [a] -> [a]
take Int
maxHistoryLength (String
s String -> [String] -> [String]
forall a. a -> [a] -> [a]
: EditWidget -> [String]
ew_history EditWidget
ew)
                else EditWidget -> [String]
ew_history EditWidget
ew
     in EditWidget
ew
            { ew_history = newHist
            , ew_historyIndex = -1
            , ew_historySavedContent = Nothing
            }

editWidgetHistoryUp' :: t -> t1 -> EditWidget -> EditWidget
editWidgetHistoryUp' :: forall t t1. t -> t1 -> EditWidget -> EditWidget
editWidgetHistoryUp' t
_ t1
_ EditWidget
ew = (Int -> Int -> Int) -> EditWidget -> EditWidget
forall t. Num t => (Int -> t -> Int) -> EditWidget -> EditWidget
editWidgetHistory Int -> Int -> Int
forall a. Num a => a -> a -> a
(+) EditWidget
ew

editWidgetHistoryDown' :: t -> t1 -> EditWidget -> EditWidget
editWidgetHistoryDown' :: forall t t1. t -> t1 -> EditWidget -> EditWidget
editWidgetHistoryDown' t
_ t1
_ EditWidget
ew = (Int -> Int -> Int) -> EditWidget -> EditWidget
forall t. Num t => (Int -> t -> Int) -> EditWidget -> EditWidget
editWidgetHistory (-) EditWidget
ew

-- ew_historyList: list of history items, i.e. non-null strings which were
--   entered into the widget and confirmed with ENTER or which were added
--   via editWidgetSetContent.
-- ew_historyIndex: the index of the history item shown in the widget. The
--   value -1 means that the value saved in ew_historySavedContent should
--   be shown.
editWidgetHistory :: (Num t) => (Int -> t -> Int) -> EditWidget -> EditWidget
editWidgetHistory :: forall t. Num t => (Int -> t -> Int) -> EditWidget -> EditWidget
editWidgetHistory Int -> t -> Int
op EditWidget
ew =
    let i :: Int
i = EditWidget -> Int
ew_historyIndex EditWidget
ew
        l :: [String]
l = EditWidget -> [String]
ew_history EditWidget
ew
        j :: Int
j = Int
i Int -> t -> Int
`op` t
1
     in if Int
j Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0 Bool -> Bool -> Bool
&& Int
j Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< [String] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [String]
l
            then
                let savedContent :: Maybe String
savedContent =
                        case EditWidget -> Maybe String
ew_historySavedContent EditWidget
ew of
                            Maybe String
Nothing -> String -> Maybe String
forall a. a -> Maybe a
Just (EditWidget -> String
ew_content EditWidget
ew)
                            Maybe String
x -> Maybe String
x
                 in EditWidget
ew
                        { ew_historyIndex = j
                        , ew_content = l !! j
                        , ew_historySavedContent = savedContent
                        , ew_xcursor = 0
                        , ew_xoffset = 0
                        }
            else
                if Int
j Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== -Int
1
                    then case EditWidget -> Maybe String
ew_historySavedContent EditWidget
ew of
                        Maybe String
Nothing -> EditWidget
ew
                        Just String
x ->
                            EditWidget
ew
                                { ew_content = x
                                , ew_historyIndex = j
                                , ew_xcursor = 0
                                , ew_xoffset = 0
                                }
                    else EditWidget
ew

--
-- Text widget
--

data TextWidget = TextWidget
    { TextWidget -> String
tw_text :: String
    , TextWidget -> Int
tw_yoffset :: Int
    , TextWidget -> Int
tw_xoffset :: Int
    , TextWidget -> TextWidgetOptions
tw_options :: TextWidgetOptions
    }
    deriving (TextWidget -> TextWidget -> Bool
(TextWidget -> TextWidget -> Bool)
-> (TextWidget -> TextWidget -> Bool) -> Eq TextWidget
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TextWidget -> TextWidget -> Bool
== :: TextWidget -> TextWidget -> Bool
$c/= :: TextWidget -> TextWidget -> Bool
/= :: TextWidget -> TextWidget -> Bool
Eq, Int -> TextWidget -> ShowS
[TextWidget] -> ShowS
TextWidget -> String
(Int -> TextWidget -> ShowS)
-> (TextWidget -> String)
-> ([TextWidget] -> ShowS)
-> Show TextWidget
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TextWidget -> ShowS
showsPrec :: Int -> TextWidget -> ShowS
$cshow :: TextWidget -> String
show :: TextWidget -> String
$cshowList :: [TextWidget] -> ShowS
showList :: [TextWidget] -> ShowS
Show)

instance Widget TextWidget where
    draw :: Size -> Size -> DrawingHint -> TextWidget -> IO ()
draw = Size -> Size -> DrawingHint -> TextWidget -> IO ()
drawTextWidget
    minSize :: TextWidget -> Size
minSize TextWidget
tw =
        case TextWidgetOptions -> TextWidgetSize
twopt_size (TextWidgetOptions -> TextWidgetSize)
-> TextWidgetOptions -> TextWidgetSize
forall a b. (a -> b) -> a -> b
$ TextWidget -> TextWidgetOptions
tw_options TextWidget
tw of
            TextWidgetSize
TWSizeDefault ->
                let l :: [String]
l = String -> [String]
lines (TextWidget -> String
tw_text TextWidget
tw)
                 in ([String] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [String]
l, if [String] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
l then Int
0 else [Int] -> Int
forall a. Ord a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum ((String -> Int) -> [String] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map String -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [String]
l))
            TWSizeFixed Size
sz -> Size
sz

data TextWidgetSize
    = TWSizeDefault -- minimal size determined by content
    | TWSizeFixed Size -- minimal size is fixed, content is
    -- possibly cut off
    deriving (TextWidgetSize -> TextWidgetSize -> Bool
(TextWidgetSize -> TextWidgetSize -> Bool)
-> (TextWidgetSize -> TextWidgetSize -> Bool) -> Eq TextWidgetSize
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TextWidgetSize -> TextWidgetSize -> Bool
== :: TextWidgetSize -> TextWidgetSize -> Bool
$c/= :: TextWidgetSize -> TextWidgetSize -> Bool
/= :: TextWidgetSize -> TextWidgetSize -> Bool
Eq, Int -> TextWidgetSize -> ShowS
[TextWidgetSize] -> ShowS
TextWidgetSize -> String
(Int -> TextWidgetSize -> ShowS)
-> (TextWidgetSize -> String)
-> ([TextWidgetSize] -> ShowS)
-> Show TextWidgetSize
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TextWidgetSize -> ShowS
showsPrec :: Int -> TextWidgetSize -> ShowS
$cshow :: TextWidgetSize -> String
show :: TextWidgetSize -> String
$cshowList :: [TextWidgetSize] -> ShowS
showList :: [TextWidgetSize] -> ShowS
Show)

{-
\| Autowrap   -- minimal width determined by content,
             -- but lines are wrapped if necessary
             -}

data TextWidgetOptions = TWOptions
    { TextWidgetOptions -> TextWidgetSize
twopt_size :: TextWidgetSize
    , TextWidgetOptions -> DrawingStyle
twopt_style :: DrawingStyle
    , TextWidgetOptions -> HAlignment
twopt_halign :: HAlignment
    }
    deriving (TextWidgetOptions -> TextWidgetOptions -> Bool
(TextWidgetOptions -> TextWidgetOptions -> Bool)
-> (TextWidgetOptions -> TextWidgetOptions -> Bool)
-> Eq TextWidgetOptions
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TextWidgetOptions -> TextWidgetOptions -> Bool
== :: TextWidgetOptions -> TextWidgetOptions -> Bool
$c/= :: TextWidgetOptions -> TextWidgetOptions -> Bool
/= :: TextWidgetOptions -> TextWidgetOptions -> Bool
Eq, Int -> TextWidgetOptions -> ShowS
[TextWidgetOptions] -> ShowS
TextWidgetOptions -> String
(Int -> TextWidgetOptions -> ShowS)
-> (TextWidgetOptions -> String)
-> ([TextWidgetOptions] -> ShowS)
-> Show TextWidgetOptions
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TextWidgetOptions -> ShowS
showsPrec :: Int -> TextWidgetOptions -> ShowS
$cshow :: TextWidgetOptions -> String
show :: TextWidgetOptions -> String
$cshowList :: [TextWidgetOptions] -> ShowS
showList :: [TextWidgetOptions] -> ShowS
Show)

defaultTWOptions :: TextWidgetOptions
defaultTWOptions :: TextWidgetOptions
defaultTWOptions =
    TWOptions
        { twopt_size :: TextWidgetSize
twopt_size = TextWidgetSize
TWSizeDefault
        , twopt_style :: DrawingStyle
twopt_style = DrawingStyle
defaultDrawingStyle
        , twopt_halign :: HAlignment
twopt_halign = HAlignment
AlignLeft
        }

newTextWidget :: TextWidgetOptions -> String -> TextWidget
newTextWidget :: TextWidgetOptions -> String -> TextWidget
newTextWidget TextWidgetOptions
opts String
s =
    TextWidget
        { tw_text :: String
tw_text = String
s
        , tw_yoffset :: Int
tw_yoffset = Int
0
        , tw_xoffset :: Int
tw_xoffset = Int
0
        , tw_options :: TextWidgetOptions
tw_options = TextWidgetOptions
opts
        }

drawTextWidget :: Pos -> Size -> DrawingHint -> TextWidget -> IO ()
drawTextWidget :: Size -> Size -> DrawingHint -> TextWidget -> IO ()
drawTextWidget (Int
y, Int
x) (Int
height, Int
width) DrawingHint
hint TextWidget
tw =
    let ly :: [String]
ly = Int -> [String] -> [String]
forall a. Int -> [a] -> [a]
take Int
height ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$ Int -> [String] -> [String]
forall a. Int -> [a] -> [a]
drop (TextWidget -> Int
tw_yoffset TextWidget
tw) (String -> [String]
lines (TextWidget -> String
tw_text TextWidget
tw))
        l :: [String]
l = Int -> [String] -> [String]
forall a. Int -> [a] -> [a]
take Int
height ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$ (ShowS -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> ShowS
forall a. Int -> [a] -> [a]
drop (TextWidget -> Int
tw_xoffset TextWidget
tw)) [String]
ly [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ String -> [String]
forall a. a -> [a]
repeat [])
        l' :: [String]
l' = ShowS -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (HAlignment -> Int -> Char -> ShowS
forall a. HAlignment -> Int -> a -> [a] -> [a]
align (TextWidgetOptions -> HAlignment
twopt_halign (TextWidgetOptions -> HAlignment)
-> TextWidgetOptions -> HAlignment
forall a b. (a -> b) -> a -> b
$ TextWidget -> TextWidgetOptions
tw_options TextWidget
tw) Int
width Char
' ') [String]
l
     in -- trace ("drawing text widget at " ++ show pos ++ " with size " ++ show sz) $
        do
            DrawingHint -> DrawingStyle -> IO [()] -> IO [()]
forall a. DrawingHint -> DrawingStyle -> IO a -> IO a
_draw
                DrawingHint
hint
                (TextWidgetOptions -> DrawingStyle
twopt_style (TextWidgetOptions -> DrawingStyle)
-> (TextWidget -> TextWidgetOptions) -> TextWidget -> DrawingStyle
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TextWidget -> TextWidgetOptions
tw_options (TextWidget -> DrawingStyle) -> TextWidget -> DrawingStyle
forall a b. (a -> b) -> a -> b
$ TextWidget
tw)
                (((String, Int) -> IO ()) -> [(String, Int)] -> IO [()]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (String, Int) -> IO ()
drawLine ([(String, Int)] -> IO [()]) -> [(String, Int)] -> IO [()]
forall a b. (a -> b) -> a -> b
$ [String] -> [Int] -> [(String, Int)]
forall a b. [a] -> [b] -> [(a, b)]
zip [String]
l' [Int
0 ..])
            IO ()
Curses.refresh
  where
    drawLine :: (String, Int) -> IO ()
drawLine (String
s, Int
i) =
        do
            Window -> Int -> Int -> IO ()
Curses.wMove Window
Curses.stdScr (Int
y Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
i) Int
x
            Int -> String -> IO ()
CursesH.drawLine Int
width String
s

textWidgetGetText :: TextWidget -> String
textWidgetGetText :: TextWidget -> String
textWidgetGetText = TextWidget -> String
tw_text

textWidgetSetText :: TextWidget -> String -> TextWidget
textWidgetSetText :: TextWidget -> String -> TextWidget
textWidgetSetText TextWidget
tw String
s = TextWidget
tw {tw_text = s}

textWidgetScrollDown :: Size -> TextWidget -> TextWidget
textWidgetScrollDown :: Size -> TextWidget -> TextWidget
textWidgetScrollDown (Int
h, Int
_) TextWidget
tw =
    let dataLen :: Int
dataLen = [String] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([String] -> Int) -> [String] -> Int
forall a b. (a -> b) -> a -> b
$ String -> [String]
lines (TextWidget -> String
tw_text TextWidget
tw)
        offset :: Int
offset = TextWidget -> Int
tw_yoffset TextWidget
tw
     in TextWidget
tw {tw_yoffset = scrollForward dataLen offset h}

textWidgetScrollUp :: Size -> TextWidget -> TextWidget
textWidgetScrollUp :: Size -> TextWidget -> TextWidget
textWidgetScrollUp (Int
h, Int
_) TextWidget
tw =
    let dataLen :: Int
dataLen = [String] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([String] -> Int) -> [String] -> Int
forall a b. (a -> b) -> a -> b
$ String -> [String]
lines (TextWidget -> String
tw_text TextWidget
tw)
        offset :: Int
offset = TextWidget -> Int
tw_yoffset TextWidget
tw
     in TextWidget
tw {tw_yoffset = scrollBackward dataLen offset h}

textWidgetScrollLeft :: Size -> TextWidget -> TextWidget
textWidgetScrollLeft :: Size -> TextWidget -> TextWidget
textWidgetScrollLeft (Int
_, Int
w) TextWidget
tw =
    let dataLen :: Int
dataLen = [String] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([String] -> Int) -> [String] -> Int
forall a b. (a -> b) -> a -> b
$ String -> [String]
lines (TextWidget -> String
tw_text TextWidget
tw)
        offset :: Int
offset = TextWidget -> Int
tw_xoffset TextWidget
tw
     in TextWidget
tw {tw_xoffset = scrollBackward dataLen offset w}

textWidgetScrollRight :: Size -> TextWidget -> TextWidget
textWidgetScrollRight :: Size -> TextWidget -> TextWidget
textWidgetScrollRight (Int
_, Int
w) TextWidget
tw =
    let dataLen :: Int
dataLen = [String] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([String] -> Int) -> [String] -> Int
forall a b. (a -> b) -> a -> b
$ String -> [String]
lines (TextWidget -> String
tw_text TextWidget
tw)
        offset :: Int
offset = TextWidget -> Int
tw_xoffset TextWidget
tw
     in TextWidget
tw {tw_xoffset = scrollForward dataLen offset w}

--
-- Table widget
--

data TableCell
    = forall w. (Widget w) => TableCell w
    | forall w. (ActiveWidget w) => ActiveTableCell w

isActive :: TableCell -> Bool
isActive :: TableCell -> Bool
isActive (TableCell w
_) = Bool
False
isActive (ActiveTableCell w
_) = Bool
True

instance Widget TableCell where
    draw :: Size -> Size -> DrawingHint -> TableCell -> IO ()
draw Size
pos Size
sz DrawingHint
hint (TableCell w
w) = Size -> Size -> DrawingHint -> w -> IO ()
forall a. Widget a => Size -> Size -> DrawingHint -> a -> IO ()
draw Size
pos Size
sz DrawingHint
hint w
w
    draw Size
pos Size
sz DrawingHint
hint (ActiveTableCell w
w) = Size -> Size -> DrawingHint -> w -> IO ()
forall a. Widget a => Size -> Size -> DrawingHint -> a -> IO ()
draw Size
pos Size
sz DrawingHint
hint w
w
    minSize :: TableCell -> Size
minSize (TableCell w
w) = w -> Size
forall a. Widget a => a -> Size
minSize w
w
    minSize (ActiveTableCell w
w) = w -> Size
forall a. Widget a => a -> Size
minSize w
w

_activateTableCell ::
    (MonadIO m, MonadMask m) =>
    m () ->
    Pos ->
    Size ->
    TableCell ->
    m (TableCell, String)
_activateTableCell :: forall (m :: * -> *).
(MonadIO m, MonadMask m) =>
m () -> Size -> Size -> TableCell -> m (TableCell, String)
_activateTableCell m ()
_ Size
_ Size
_ (TableCell w
_) =
    String -> m (TableCell, String)
forall a. HasCallStack => String -> a
error String
"_activateTableCell: cannot activate non-active cell!"
_activateTableCell m ()
refresh Size
pos Size
sz (ActiveTableCell w
w) =
    do
        (new, res) <- m () -> Size -> Size -> w -> m (w, String)
forall a (m :: * -> *).
(ActiveWidget a, MonadIO m, MonadMask m) =>
m () -> Size -> Size -> a -> m (a, String)
forall (m :: * -> *).
(MonadIO m, MonadMask m) =>
m () -> Size -> Size -> w -> m (w, String)
activate m ()
refresh Size
pos Size
sz w
w
        return (ActiveTableCell new, res)

type Row = [TableCell]

singletonRow :: TableCell -> Row
singletonRow :: TableCell -> Row
singletonRow TableCell
tc = [TableCell
tc]

getCellWidget :: TableWidget -> (Int, Int) -> TableCell
getCellWidget :: TableWidget -> Size -> TableCell
getCellWidget TableWidget
tbw (Int
row, Int
col) = (TableWidget -> [Row]
tbw_rows TableWidget
tbw) [Row] -> Int -> Row
forall a. HasCallStack => [a] -> Int -> a
!! Int
row Row -> Int -> TableCell
forall a. HasCallStack => [a] -> Int -> a
!! Int
col

setCellWidget :: TableWidget -> (Int, Int) -> TableCell -> TableWidget
setCellWidget :: TableWidget -> Size -> TableCell -> TableWidget
setCellWidget TableWidget
tbw (Int
rowIndex, Int
colIndex) TableCell
w =
    let rows :: [Row]
rows = TableWidget -> [Row]
tbw_rows TableWidget
tbw
        row :: Row
row = [Row]
rows [Row] -> Int -> Row
forall a. HasCallStack => [a] -> Int -> a
!! Int
rowIndex
        newRow :: Row
newRow = Row -> TableCell -> Int -> Row
forall a. [a] -> a -> Int -> [a]
listReplace Row
row TableCell
w Int
colIndex
        newRows :: [Row]
newRows = [Row] -> Row -> Int -> [Row]
forall a. [a] -> a -> Int -> [a]
listReplace [Row]
rows Row
newRow Int
rowIndex
     in TableWidget
tbw {tbw_rows = newRows}

data TableWidget = TableWidget
    { TableWidget -> [Row]
tbw_rows :: [Row]
    , TableWidget -> Int
tbw_colOffset :: Int
    , TableWidget -> Maybe Size
tbw_pos :: Maybe Pos
    , TableWidget -> TableWidgetOptions
tbw_options :: TableWidgetOptions
    }

data FillRow = First | Last | None deriving (FillRow -> FillRow -> Bool
(FillRow -> FillRow -> Bool)
-> (FillRow -> FillRow -> Bool) -> Eq FillRow
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: FillRow -> FillRow -> Bool
== :: FillRow -> FillRow -> Bool
$c/= :: FillRow -> FillRow -> Bool
/= :: FillRow -> FillRow -> Bool
Eq, Int -> FillRow -> ShowS
[FillRow] -> ShowS
FillRow -> String
(Int -> FillRow -> ShowS)
-> (FillRow -> String) -> ([FillRow] -> ShowS) -> Show FillRow
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> FillRow -> ShowS
showsPrec :: Int -> FillRow -> ShowS
$cshow :: FillRow -> String
show :: FillRow -> String
$cshowList :: [FillRow] -> ShowS
showList :: [FillRow] -> ShowS
Show)

data TableWidgetOptions = TBWOptions
    { TableWidgetOptions -> Maybe Int
tbwopt_fillCol :: Maybe Int
    , TableWidgetOptions -> FillRow
tbwopt_fillRow :: FillRow
    , TableWidgetOptions -> [Int]
tbwopt_activeCols :: [Int]
    , TableWidgetOptions -> Size
tbwopt_minSize :: Size
    }
    deriving (TableWidgetOptions -> TableWidgetOptions -> Bool
(TableWidgetOptions -> TableWidgetOptions -> Bool)
-> (TableWidgetOptions -> TableWidgetOptions -> Bool)
-> Eq TableWidgetOptions
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TableWidgetOptions -> TableWidgetOptions -> Bool
== :: TableWidgetOptions -> TableWidgetOptions -> Bool
$c/= :: TableWidgetOptions -> TableWidgetOptions -> Bool
/= :: TableWidgetOptions -> TableWidgetOptions -> Bool
Eq, Int -> TableWidgetOptions -> ShowS
[TableWidgetOptions] -> ShowS
TableWidgetOptions -> String
(Int -> TableWidgetOptions -> ShowS)
-> (TableWidgetOptions -> String)
-> ([TableWidgetOptions] -> ShowS)
-> Show TableWidgetOptions
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TableWidgetOptions -> ShowS
showsPrec :: Int -> TableWidgetOptions -> ShowS
$cshow :: TableWidgetOptions -> String
show :: TableWidgetOptions -> String
$cshowList :: [TableWidgetOptions] -> ShowS
showList :: [TableWidgetOptions] -> ShowS
Show)

defaultTBWOptions :: TableWidgetOptions
defaultTBWOptions :: TableWidgetOptions
defaultTBWOptions =
    TBWOptions
        { tbwopt_fillCol :: Maybe Int
tbwopt_fillCol = Maybe Int
forall a. Maybe a
Nothing
        , tbwopt_fillRow :: FillRow
tbwopt_fillRow = FillRow
None
        , tbwopt_activeCols :: [Int]
tbwopt_activeCols = []
        , tbwopt_minSize :: Size
tbwopt_minSize = (Int
4, Int
10)
        }

instance Widget TableWidget where
    draw :: Size -> Size -> DrawingHint -> TableWidget -> IO ()
draw = Size -> Size -> DrawingHint -> TableWidget -> IO ()
drawTableWidget
    minSize :: TableWidget -> Size
minSize = TableWidgetOptions -> Size
tbwopt_minSize (TableWidgetOptions -> Size)
-> (TableWidget -> TableWidgetOptions) -> TableWidget -> Size
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TableWidget -> TableWidgetOptions
tbw_options

newTableWidget :: TableWidgetOptions -> [Row] -> TableWidget
newTableWidget :: TableWidgetOptions -> [Row] -> TableWidget
newTableWidget TableWidgetOptions
opts [Row]
rows =
    TableWidget
        { tbw_rows :: [Row]
tbw_rows = [Row]
rows
        , tbw_colOffset :: Int
tbw_colOffset = Int
0
        , tbw_pos :: Maybe Size
tbw_pos = [Row] -> TableWidgetOptions -> Maybe Size
findFirstActiveCell [Row]
rows TableWidgetOptions
opts
        , tbw_options :: TableWidgetOptions
tbw_options = TableWidgetOptions
opts
        }

data TableWidgetDisplayInfo
    = TBWDisplayInfo
    { TableWidgetDisplayInfo -> Int
tbwdisp_height :: Int -- height of the display area
    , TableWidgetDisplayInfo -> Int
tbwdisp_width :: Int -- width of the display area
    , TableWidgetDisplayInfo -> Int
tbwdisp_firstVis :: Int -- index of the first row visible
    , TableWidgetDisplayInfo -> Int
tbwdisp_lastVis :: Int -- index of the last row visible
    , TableWidgetDisplayInfo -> [Row]
tbwdisp_rows :: [Row] -- the rows which are visible
    , TableWidgetDisplayInfo -> Int
tbwdisp_nrows :: Int -- the number of rows visible
    , TableWidgetDisplayInfo -> [Int]
tbwdisp_heights :: [Int] -- the heights of the visible rows
    , TableWidgetDisplayInfo -> [Int]
tbwdisp_widths :: [Int] -- the widths of the visible rows
    -- free space at the right side (xoffset, size)
    , TableWidgetDisplayInfo -> Maybe (Int, Size)
tbwdisp_rightMargin :: Maybe (Int, Size)
    }

tableWidgetDisplayInfo :: Size -> TableWidget -> TableWidgetDisplayInfo
tableWidgetDisplayInfo :: Size -> TableWidget -> TableWidgetDisplayInfo
tableWidgetDisplayInfo (Int
height, Int
width) TableWidget
tbw =
    Bool -> TableWidgetDisplayInfo -> TableWidgetDisplayInfo
forall a. HasCallStack => Bool -> a -> a
assert ([Row] -> Bool
forall {t :: * -> *} {a}. Foldable t => [t a] -> Bool
isQuadratic (TableWidget -> [Row]
tbw_rows TableWidget
tbw)) (TableWidgetDisplayInfo -> TableWidgetDisplayInfo)
-> TableWidgetDisplayInfo -> TableWidgetDisplayInfo
forall a b. (a -> b) -> a -> b
$
        let allRows :: [Row]
allRows = TableWidget -> [Row]
tbw_rows TableWidget
tbw
            ncols :: Int
ncols = Row -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([Row]
allRows [Row] -> Int -> Row
forall a. HasCallStack => [a] -> Int -> a
!! Int
0)
            colOffset :: Int
colOffset = TableWidget -> Int
tbw_colOffset TableWidget
tbw
            allHeights :: [Int]
allHeights = (Size -> Int) -> [Row] -> [Int]
forall {t :: * -> *} {b} {a}.
(Traversable t, Num b, Ord b, Widget a) =>
(Size -> b) -> t [a] -> t b
minSpaces Size -> Int
getHeight [Row]
allRows
            heights' :: [Int]
heights' = Int -> [Int] -> [Int]
forall a. Int -> [a] -> [a]
drop Int
colOffset [Int]
allHeights
            nrows :: Int
nrows = [Int] -> Int -> Int -> Int
forall {t}. Num t => [Int] -> Int -> t -> t
getNRows [Int]
heights' Int
0 Int
0
            rows :: [Row]
rows = Int -> [Row] -> [Row]
forall a. Int -> [a] -> [a]
take Int
nrows ([Row] -> [Row]) -> [Row] -> [Row]
forall a b. (a -> b) -> a -> b
$ Int -> [Row] -> [Row]
forall a. Int -> [a] -> [a]
drop Int
colOffset [Row]
allRows
            ([Int]
heights, Int
heightDummy) =
                let hs :: [Int]
hs = Int -> [Int] -> [Int]
forall a. Int -> [a] -> [a]
take Int
nrows [Int]
heights'
                    s :: Int
s = [Int] -> Int
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum [Int]
hs
                    d :: Int
d = Int
height Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
s
                 in case TableWidgetOptions -> FillRow
tbwopt_fillRow (TableWidgetOptions -> FillRow) -> TableWidgetOptions -> FillRow
forall a b. (a -> b) -> a -> b
$ TableWidget -> TableWidgetOptions
tbw_options TableWidget
tbw of
                        FillRow
First -> ((Int -> Int) -> [Int] -> [Int]
forall {a}. (a -> a) -> [a] -> [a]
applyToFirst (Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
d) [Int]
hs, Int
0)
                        FillRow
Last -> ((Int -> Int) -> [Int] -> [Int]
forall {a}. (a -> a) -> [a] -> [a]
applyToLast (Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
d) [Int]
hs, Int
0)
                        FillRow
None -> ([Int]
hs, Int
d)
            widths' :: [Int]
widths' = (Size -> Int) -> [Row] -> [Int]
forall {t :: * -> *} {b} {a}.
(Traversable t, Num b, Ord b, Widget a) =>
(Size -> b) -> t [a] -> t b
minSpaces Size -> Int
getWidth ([Row] -> [Row]
forall a. [[a]] -> [[a]]
transpose ([Row] -> [Row]) -> [Row] -> [Row]
forall a b. (a -> b) -> a -> b
$ TableWidget -> [Row]
tbw_rows TableWidget
tbw)
            ([Int]
widths, Maybe (Int, Size)
rightMargin) =
                if [Int] -> Int
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum [Int]
widths' Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
width
                    then
                        String -> ([Int], Maybe (Int, Size))
forall a. HasCallStack => String -> a
error
                            ( String
"table too wide: width="
                                String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show ([Int] -> Int
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum [Int]
widths')
                                String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
", available width="
                                String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
width
                            )
                    else case TableWidgetOptions -> Maybe Int
tbwopt_fillCol (TableWidgetOptions -> Maybe Int)
-> TableWidgetOptions -> Maybe Int
forall a b. (a -> b) -> a -> b
$ TableWidget -> TableWidgetOptions
tbw_options TableWidget
tbw of
                        Just Int
i
                            | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0 Bool -> Bool -> Bool
&& Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
ncols ->
                                ( Int -> [Int] -> [Int]
forall a. Int -> [a] -> [a]
take Int
i [Int]
widths'
                                    [Int] -> [Int] -> [Int]
forall a. [a] -> [a] -> [a]
++ case Int -> [Int] -> [Int]
forall a. Int -> [a] -> [a]
drop Int
i [Int]
widths' of
                                        [] -> String -> [Int]
forall a. HasCallStack => String -> a
error String
"rest unexpectedly empty"
                                        (Int
w : [Int]
ws) -> (Int
w Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
width Int -> Int -> Int
forall a. Num a => a -> a -> a
- [Int] -> Int
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum [Int]
widths') Int -> [Int] -> [Int]
forall a. a -> [a] -> [a]
: [Int]
ws
                                , Maybe (Int, Size)
forall a. Maybe a
Nothing
                                )
                        Maybe Int
_ ->
                            let diff :: Int
diff = Int
width Int -> Int -> Int
forall a. Num a => a -> a -> a
- [Int] -> Int
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum [Int]
widths'
                                msz :: Size
msz = (Int
height, Int
diff)
                                m :: Maybe (Int, Size)
m =
                                    if Int
diff Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0
                                        then (Int, Size) -> Maybe (Int, Size)
forall a. a -> Maybe a
Just ([Int] -> Int
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum [Int]
widths', Size
msz)
                                        else Maybe (Int, Size)
forall a. Maybe a
Nothing
                             in ([Int]
widths', Maybe (Int, Size)
m)
            dummyHeights :: [Int]
dummyHeights = if Int
heightDummy Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 then [] else [Int
heightDummy]
            dummyRows :: [Row]
dummyRows =
                if Int
heightDummy Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0
                    then []
                    else
                        [ (Int -> TableCell) -> [Int] -> Row
forall a b. (a -> b) -> [a] -> [b]
map
                            (\Int
w -> OpaqueWidget -> TableCell
forall w. Widget w => w -> TableCell
TableCell (Size -> OpaqueWidget
OpaqueWidget (Int
heightDummy, Int
w)))
                            [Int]
widths
                        ]
         in TBWDisplayInfo
                { tbwdisp_height :: Int
tbwdisp_height = Int
height
                , tbwdisp_width :: Int
tbwdisp_width = Int
width
                , tbwdisp_firstVis :: Int
tbwdisp_firstVis = Int
colOffset
                , tbwdisp_lastVis :: Int
tbwdisp_lastVis = Int
colOffset Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
nrows Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1
                , tbwdisp_rows :: [Row]
tbwdisp_rows = [Row]
rows [Row] -> [Row] -> [Row]
forall a. [a] -> [a] -> [a]
++ [Row]
dummyRows
                , tbwdisp_nrows :: Int
tbwdisp_nrows = Int
nrows Int -> Int -> Int
forall a. Num a => a -> a -> a
+ [Row] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Row]
dummyRows
                , tbwdisp_heights :: [Int]
tbwdisp_heights = [Int]
heights [Int] -> [Int] -> [Int]
forall a. [a] -> [a] -> [a]
++ [Int]
dummyHeights
                , tbwdisp_widths :: [Int]
tbwdisp_widths = [Int]
widths
                , tbwdisp_rightMargin :: Maybe (Int, Size)
tbwdisp_rightMargin = Maybe (Int, Size)
rightMargin
                }
  where
    minSpaces :: (Size -> b) -> t [a] -> t b
minSpaces Size -> b
f t [a]
ls =
        (b, t b) -> t b
forall a b. (a, b) -> b
snd ((b, t b) -> t b) -> (b, t b) -> t b
forall a b. (a -> b) -> a -> b
$
            (b -> [a] -> (b, b)) -> b -> t [a] -> (b, t b)
forall (t :: * -> *) s a b.
Traversable t =>
(s -> a -> (s, b)) -> s -> t a -> (s, t b)
mapAccumL
                ( \b
acc [a]
ws ->
                    (b
acc, b
acc b -> b -> b
forall a. Num a => a -> a -> a
+ [b] -> b
forall a. Ord a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum ((a -> b) -> [a] -> [b]
forall a b. (a -> b) -> [a] -> [b]
map (Size -> b
f (Size -> b) -> (a -> Size) -> a -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Size
forall a. Widget a => a -> Size
minSize) [a]
ws))
                )
                b
0
                t [a]
ls
    getNRows :: [Int] -> Int -> t -> t
getNRows (Int
h : [Int]
hs) Int
n t
acc | Int
h Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
height = [Int] -> Int -> t -> t
getNRows [Int]
hs (Int
h Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
n) (t
acc t -> t -> t
forall a. Num a => a -> a -> a
+ t
1)
    getNRows [Int]
_ Int
_ t
acc = t
acc
    isQuadratic :: [t a] -> Bool
isQuadratic [] = Bool
True
    isQuadratic (t a
x : [t a]
xs) = [t a] -> Int -> Bool
forall {t :: * -> *} {a}. Foldable t => [t a] -> Int -> Bool
isQuadratic' [t a]
xs (t a -> Int
forall a. t a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length t a
x)
    isQuadratic' :: [t a] -> Int -> Bool
isQuadratic' (t a
x : [t a]
xs) Int
n = t a -> Int
forall a. t a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length t a
x Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
n Bool -> Bool -> Bool
&& [t a] -> Int -> Bool
isQuadratic' [t a]
xs Int
n
    isQuadratic' [] Int
_ = Bool
True
    applyToFirst :: (a -> a) -> [a] -> [a]
applyToFirst a -> a
_ [] = []
    applyToFirst a -> a
f (a
x : [a]
xs) = a -> a
f a
x a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
xs
    applyToLast :: (a -> a) -> [a] -> [a]
applyToLast a -> a
_ [] = []
    applyToLast a -> a
f (a
x : [a]
xs) =
        let rev :: NonEmpty a
rev = NonEmpty a -> NonEmpty a
forall a. NonEmpty a -> NonEmpty a
NonEmpty.reverse (NonEmpty a -> NonEmpty a) -> NonEmpty a -> NonEmpty a
forall a b. (a -> b) -> a -> b
$ a
x a -> [a] -> NonEmpty a
forall a. a -> [a] -> NonEmpty a
:| [a]
xs
            (a
h, [a]
t) = (NonEmpty a -> a
forall a. NonEmpty a -> a
NonEmpty.head NonEmpty a
rev, NonEmpty a -> [a]
forall a. NonEmpty a -> [a]
NonEmpty.tail NonEmpty a
rev)
         in [a] -> [a]
forall a. [a] -> [a]
reverse ([a] -> [a]) -> [a] -> [a]
forall a b. (a -> b) -> a -> b
$ a -> a
f a
h a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
t

getCellInfo :: Pos -> Size -> TableWidget -> (Int, Int) -> (Pos, Size)
getCellInfo :: Size -> Size -> TableWidget -> Size -> (Size, Size)
getCellInfo (Int
y, Int
x) Size
sz TableWidget
tbw (Int
row, Int
col) =
    let info :: TableWidgetDisplayInfo
info = Size -> TableWidget -> TableWidgetDisplayInfo
tableWidgetDisplayInfo Size
sz TableWidget
tbw
        heights :: [Int]
heights = TableWidgetDisplayInfo -> [Int]
tbwdisp_heights TableWidgetDisplayInfo
info
        widths :: [Int]
widths = TableWidgetDisplayInfo -> [Int]
tbwdisp_widths TableWidgetDisplayInfo
info
        h :: Int
h = [Int]
heights [Int] -> Int -> Int
forall a. HasCallStack => [a] -> Int -> a
!! Int
row
        w :: Int
w = [Int]
widths [Int] -> Int -> Int
forall a. HasCallStack => [a] -> Int -> a
!! Int
col
        yoff :: Int
yoff = [Int] -> Int
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ([Int] -> Int) -> [Int] -> Int
forall a b. (a -> b) -> a -> b
$ Int -> [Int] -> [Int]
forall a. Int -> [a] -> [a]
take Int
row [Int]
heights
        xoff :: Int
xoff = [Int] -> Int
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ([Int] -> Int) -> [Int] -> Int
forall a b. (a -> b) -> a -> b
$ Int -> [Int] -> [Int]
forall a. Int -> [a] -> [a]
take Int
col [Int]
widths
     in ((Int
y Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
yoff, Int
x Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
xoff), (Int
h, Int
w))

drawTableWidget :: Pos -> Size -> DrawingHint -> TableWidget -> IO ()
drawTableWidget :: Size -> Size -> DrawingHint -> TableWidget -> IO ()
drawTableWidget (Int
y, Int
x) Size
sz DrawingHint
hint TableWidget
tbw =
    let info :: TableWidgetDisplayInfo
info = Size -> TableWidget -> TableWidgetDisplayInfo
tableWidgetDisplayInfo Size
sz TableWidget
tbw
        heights :: [Int]
heights = TableWidgetDisplayInfo -> [Int]
tbwdisp_heights TableWidgetDisplayInfo
info
        widths :: [Int]
widths = TableWidgetDisplayInfo -> [Int]
tbwdisp_widths TableWidgetDisplayInfo
info
        firstVis :: Int
firstVis = TableWidgetDisplayInfo -> Int
tbwdisp_firstVis TableWidgetDisplayInfo
info
        rows :: [Row]
rows = TableWidgetDisplayInfo -> [Row]
tbwdisp_rows TableWidgetDisplayInfo
info
        rightMargin :: Maybe (Int, Size)
rightMargin = TableWidgetDisplayInfo -> Maybe (Int, Size)
tbwdisp_rightMargin TableWidgetDisplayInfo
info
     in do
            [Row] -> [Int] -> [Int] -> Int -> Int -> DrawingHint -> IO ()
drawRows [Row]
rows [Int]
heights [Int]
widths Int
0 Int
firstVis DrawingHint
hint
            case Maybe (Int, Size)
rightMargin of
                Maybe (Int, Size)
Nothing -> () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
                Just (Int
xoff, Size
s) -> Size -> Size -> DrawingHint -> OpaqueWidget -> IO ()
forall a. Widget a => Size -> Size -> DrawingHint -> a -> IO ()
draw (Int
y, Int
x Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
xoff) Size
s DrawingHint
hint (Size -> OpaqueWidget
OpaqueWidget Size
s)
            IO ()
Curses.refresh
  where
    drawRows ::
        [Row] ->
        [Int] ->
        [Int] ->
        Int ->
        Int ->
        DrawingHint ->
        IO ()
    drawRows :: [Row] -> [Int] -> [Int] -> Int -> Int -> DrawingHint -> IO ()
drawRows [] [Int]
_ [Int]
_ Int
_ Int
_ DrawingHint
_ = () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    drawRows (Row
r : [Row]
rs) (Int
h : [Int]
hs) [Int]
widths Int
yoffset Int
rowIndex DrawingHint
hint' =
        do
            Row -> Int -> [Int] -> Int -> Int -> Size -> DrawingHint -> IO ()
drawCols Row
r Int
h [Int]
widths Int
yoffset Int
0 (Int
rowIndex, Int
0) DrawingHint
hint'
            [Row] -> [Int] -> [Int] -> Int -> Int -> DrawingHint -> IO ()
drawRows [Row]
rs [Int]
hs [Int]
widths (Int
yoffset Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
h) (Int
rowIndex Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) DrawingHint
hint'
    drawRows [Row]
_ [Int]
_ [Int]
_ Int
_ Int
_ DrawingHint
_ = () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    drawCols ::
        Row ->
        Int ->
        [Int] ->
        Int ->
        Int ->
        (Int, Int) ->
        DrawingHint ->
        IO ()
    drawCols :: Row -> Int -> [Int] -> Int -> Int -> Size -> DrawingHint -> IO ()
drawCols [] Int
_ [Int]
_ Int
_ Int
_ Size
_ DrawingHint
_ = () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    drawCols (TableCell
c : Row
cs) Int
h (Int
w : [Int]
ws) Int
yoffset Int
xoffset (Int
rowIndex, Int
colIndex) DrawingHint
hint' =
        let hint'' :: DrawingHint
hint'' = case TableWidget -> Maybe Size
tbw_pos TableWidget
tbw of
                Just (Int
z, Int
a)
                    | Int
z Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
rowIndex Bool -> Bool -> Bool
&& Int
a Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
colIndex ->
                        DrawingHint
DHFocus
                Maybe Size
_ -> DrawingHint
hint'
         in do
                Size -> Size -> DrawingHint -> TableCell -> IO ()
forall a. Widget a => Size -> Size -> DrawingHint -> a -> IO ()
draw (Int
y Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
yoffset, Int
x Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
xoffset) (Int
h, Int
w) DrawingHint
hint'' TableCell
c
                Row -> Int -> [Int] -> Int -> Int -> Size -> DrawingHint -> IO ()
drawCols
                    Row
cs
                    Int
h
                    [Int]
ws
                    Int
yoffset
                    (Int
xoffset Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
w)
                    (Int
rowIndex, Int
colIndex Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
                    DrawingHint
hint'
    drawCols Row
_ Int
_ [Int]
_ Int
_ Int
_ Size
_ DrawingHint
_ = () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

tableWidgetScrollDown :: Size -> TableWidget -> TableWidget
tableWidgetScrollDown :: Size -> TableWidget -> TableWidget
tableWidgetScrollDown (Int
h, Int
_) TableWidget
tbw =
    let dataLen :: Int
dataLen = [Row] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([Row] -> Int) -> [Row] -> Int
forall a b. (a -> b) -> a -> b
$ TableWidget -> [Row]
tbw_rows TableWidget
tbw
        offset :: Int
offset = TableWidget -> Int
tbw_colOffset TableWidget
tbw
        newOffset :: Int
newOffset = Int -> Int -> Int -> Int
scrollForward Int
dataLen Int
offset Int
h
        newTbw :: TableWidget
newTbw = TableWidget
tbw {tbw_colOffset = newOffset}
     in case TableWidget -> Maybe Size
tbw_pos TableWidget
newTbw of
            Maybe Size
Nothing -> TableWidget
newTbw
            Just (Int
y, Int
x) -> TableWidget
newTbw {tbw_pos = Just (max newOffset y, x)}

tableWidgetScrollUp :: Size -> TableWidget -> TableWidget
tableWidgetScrollUp :: Size -> TableWidget -> TableWidget
tableWidgetScrollUp sz :: Size
sz@(Int
h, Int
_) TableWidget
tbw =
    let dataLen :: Int
dataLen = [Row] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([Row] -> Int) -> [Row] -> Int
forall a b. (a -> b) -> a -> b
$ TableWidget -> [Row]
tbw_rows TableWidget
tbw
        offset :: Int
offset = TableWidget -> Int
tbw_colOffset TableWidget
tbw
        newOffset :: Int
newOffset = Int -> Int -> Int -> Int
forall t. t -> Int -> Int -> Int
scrollBackward Int
dataLen Int
offset Int
h
        newTbw :: TableWidget
newTbw = TableWidget
tbw {tbw_colOffset = newOffset}
        newLastVis :: Int
newLastVis = TableWidgetDisplayInfo -> Int
tbwdisp_lastVis (Size -> TableWidget -> TableWidgetDisplayInfo
tableWidgetDisplayInfo Size
sz TableWidget
newTbw)
     in case TableWidget -> Maybe Size
tbw_pos TableWidget
newTbw of
            Maybe Size
Nothing -> TableWidget
newTbw
            Just (Int
y, Int
x) ->
                TableWidget
newTbw {tbw_pos = Just (min newLastVis y, x)}

tableWidgetActivateCurrent ::
    (MonadIO m, MonadMask m) =>
    m () ->
    Pos ->
    Size ->
    DrawingHint ->
    TableWidget ->
    m (TableWidget, Maybe String)
tableWidgetActivateCurrent :: forall (m :: * -> *).
(MonadIO m, MonadMask m) =>
m ()
-> Size
-> Size
-> DrawingHint
-> TableWidget
-> m (TableWidget, Maybe String)
tableWidgetActivateCurrent m ()
refresh (Int
y, Int
x) Size
sz DrawingHint
_ TableWidget
tbw =
    case TableWidget -> Maybe Size
tbw_pos TableWidget
tbw of
        Maybe Size
Nothing -> do
            String -> m ()
forall (m :: * -> *). MonadIO m => String -> m ()
debug String
"tableWidgetActivateCurrent: pos=Nothing"
            (TableWidget, Maybe String) -> m (TableWidget, Maybe String)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (TableWidget
tbw, Maybe String
forall a. Maybe a
Nothing)
        Just Size
p ->
            let w :: TableCell
w = TableWidget -> Size -> TableCell
getCellWidget TableWidget
tbw Size
p
             in if Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ TableCell -> Bool
isActive TableCell
w
                    then do
                        String -> m ()
forall (m :: * -> *). MonadIO m => String -> m ()
debug String
"tableWidgetActivateCurrent: not active"
                        (TableWidget, Maybe String) -> m (TableWidget, Maybe String)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (TableWidget
tbw, Maybe String
forall a. Maybe a
Nothing)
                    else TableCell -> Size -> m (TableWidget, Maybe String)
activate' TableCell
w Size
p
  where
    activate' :: TableCell -> Size -> m (TableWidget, Maybe String)
activate' TableCell
widget colyx :: Size
colyx@(Int
coly, Int
colx) =
        let info :: TableWidgetDisplayInfo
info = Size -> TableWidget -> TableWidgetDisplayInfo
tableWidgetDisplayInfo Size
sz TableWidget
tbw
            vcol :: Int
vcol = Int
colx
            vrow :: Int
vrow = Int
coly Int -> Int -> Int
forall a. Num a => a -> a -> a
- TableWidgetDisplayInfo -> Int
tbwdisp_firstVis TableWidgetDisplayInfo
info
            heights :: [Int]
heights = TableWidgetDisplayInfo -> [Int]
tbwdisp_heights TableWidgetDisplayInfo
info
            widths :: [Int]
widths = TableWidgetDisplayInfo -> [Int]
tbwdisp_widths TableWidgetDisplayInfo
info
            h :: Int
h = [Int]
heights [Int] -> Int -> Int
forall a. HasCallStack => [a] -> Int -> a
!! Int
vrow
            w :: Int
w = [Int]
widths [Int] -> Int -> Int
forall a. HasCallStack => [a] -> Int -> a
!! Int
vcol
            yoffset :: Int
yoffset = [Int] -> Int
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum (Int -> [Int] -> [Int]
forall a. Int -> [a] -> [a]
take Int
vrow [Int]
heights)
            xoffset :: Int
xoffset = [Int] -> Int
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum (Int -> [Int] -> [Int]
forall a. Int -> [a] -> [a]
take Int
vcol [Int]
widths)
         in do
                (new, res) <-
                    m () -> Size -> Size -> TableCell -> m (TableCell, String)
forall (m :: * -> *).
(MonadIO m, MonadMask m) =>
m () -> Size -> Size -> TableCell -> m (TableCell, String)
_activateTableCell
                        m ()
refresh
                        (Int
y Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
yoffset, Int
x Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
xoffset)
                        (Int
h, Int
w)
                        TableCell
widget
                return (setCellWidget tbw colyx new, Just res)

tableWidgetGoLeft :: Size -> TableWidget -> TableWidget
tableWidgetGoLeft :: Size -> TableWidget -> TableWidget
tableWidgetGoLeft = Direction -> Size -> TableWidget -> TableWidget
tableWidgetMove Direction
DirLeft

tableWidgetGoRight :: Size -> TableWidget -> TableWidget
tableWidgetGoRight :: Size -> TableWidget -> TableWidget
tableWidgetGoRight = Direction -> Size -> TableWidget -> TableWidget
tableWidgetMove Direction
DirRight

tableWidgetGoUp :: Size -> TableWidget -> TableWidget
tableWidgetGoUp :: Size -> TableWidget -> TableWidget
tableWidgetGoUp = Direction -> Size -> TableWidget -> TableWidget
tableWidgetMove Direction
DirUp

tableWidgetGoDown :: Size -> TableWidget -> TableWidget
tableWidgetGoDown :: Size -> TableWidget -> TableWidget
tableWidgetGoDown = Direction -> Size -> TableWidget -> TableWidget
tableWidgetMove Direction
DirDown

tableWidgetMove ::
    Direction ->
    (Int, Int) ->
    TableWidget ->
    TableWidget
tableWidgetMove :: Direction -> Size -> TableWidget -> TableWidget
tableWidgetMove Direction
dir Size
sz TableWidget
tbw =
    let pos :: Maybe Size
pos = TableWidget -> Maybe Size
tbw_pos TableWidget
tbw
        opts :: TableWidgetOptions
opts = TableWidget -> TableWidgetOptions
tbw_options TableWidget
tbw
        nrows :: Int
nrows = [Row] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (TableWidget -> [Row]
tbw_rows TableWidget
tbw)
     in case Maybe Size
pos of
            Maybe Size
Nothing -> TableWidget
tbw
            Just Size
p -> case TableWidgetOptions -> Int -> Size -> Direction -> Maybe Size
findNextActiveCell TableWidgetOptions
opts Int
nrows Size
p Direction
dir of
                Maybe Size
Nothing -> TableWidget
tbw
                newP :: Maybe Size
newP@(Just (Int
y, Int
_)) ->
                    TableWidget -> Size -> Int -> TableWidget
tableWidgetMakeVisible (TableWidget
tbw {tbw_pos = newP}) Size
sz Int
y

tableWidgetMakeVisible ::
    TableWidget ->
    (Int, Int) ->
    Int ->
    TableWidget
tableWidgetMakeVisible :: TableWidget -> Size -> Int -> TableWidget
tableWidgetMakeVisible TableWidget
tbw sz :: Size
sz@(Int
_, Int
_) Int
y =
    let info :: TableWidgetDisplayInfo
info = Size -> TableWidget -> TableWidgetDisplayInfo
tableWidgetDisplayInfo Size
sz TableWidget
tbw
        firstVis :: Int
firstVis = TableWidgetDisplayInfo -> Int
tbwdisp_firstVis TableWidgetDisplayInfo
info
        lastVis :: Int
lastVis = TableWidgetDisplayInfo -> Int
tbwdisp_lastVis TableWidgetDisplayInfo
info
     in if Int
y Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
firstVis
            then TableWidget -> Size -> Int -> TableWidget
tableWidgetMakeVisible (Size -> TableWidget -> TableWidget
tableWidgetScrollUp Size
sz TableWidget
tbw) Size
sz Int
y
            else
                if Int
y Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
lastVis
                    then
                        TableWidget -> Size -> Int -> TableWidget
tableWidgetMakeVisible
                            (Size -> TableWidget -> TableWidget
tableWidgetScrollDown Size
sz TableWidget
tbw)
                            Size
sz
                            Int
y
                    else TableWidget
tbw

findFirstActiveCell :: [Row] -> TableWidgetOptions -> Maybe Pos
findFirstActiveCell :: [Row] -> TableWidgetOptions -> Maybe Size
findFirstActiveCell [Row]
rows TableWidgetOptions
opts =
    let nrows :: Int
nrows = [Row] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Row]
rows
        firstActiveCells :: [Maybe Size]
firstActiveCells =
            (Int -> Maybe Size) -> [Int] -> [Maybe Size]
forall a b. (a -> b) -> [a] -> [b]
map
                ( \Int
y ->
                    TableWidgetOptions -> Int -> Size -> Direction -> Maybe Size
findNextActiveCell
                        TableWidgetOptions
opts
                        Int
nrows
                        (Int
y, -Int
1)
                        Direction
DirRight
                )
                [Int
0 .. Int
nrows Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1]
     in case [Maybe Size] -> [Size]
forall a. [Maybe a] -> [a]
catMaybes [Maybe Size]
firstActiveCells of
            [] -> Maybe Size
forall a. Maybe a
Nothing
            (Size
x : [Size]
_) -> Size -> Maybe Size
forall a. a -> Maybe a
Just Size
x

findNextActiveCell ::
    TableWidgetOptions ->
    Int ->
    Pos ->
    Direction ->
    Maybe Pos
findNextActiveCell :: TableWidgetOptions -> Int -> Size -> Direction -> Maybe Size
findNextActiveCell TableWidgetOptions
opts Int
nrows (Int
y, Int
x) Direction
dir =
    --    trace ("findNextActiveCell (opts=" ++ show opts ++ ", nrows=" ++ show nrows
    --           ++ ", pos=" ++ show pos ++ ", dir=" ++ show dir) $
    let rows :: [Int]
rows = [Int
0 .. (Int
nrows Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)]
        cols :: [Int]
cols = [Int] -> [Int]
forall a. Ord a => [a] -> [a]
sort (TableWidgetOptions -> [Int]
tbwopt_activeCols TableWidgetOptions
opts)
        horiz :: ([Int] -> Int -> [Int] -> Int -> Maybe b) -> Maybe (Int, b)
horiz [Int] -> Int -> [Int] -> Int -> Maybe b
f = case [Int] -> Int -> [Int] -> Int -> Maybe b
f [Int]
cols Int
x [Int]
rows Int
y of
            Maybe b
Nothing -> Maybe (Int, b)
forall a. Maybe a
Nothing
            Just b
z -> (Int, b) -> Maybe (Int, b)
forall a. a -> Maybe a
Just (Int
y, b
z)
        vert :: ([Int] -> Int -> [Int] -> Int -> Maybe a) -> Maybe (a, Int)
vert [Int] -> Int -> [Int] -> Int -> Maybe a
f = case [Int] -> Int -> [Int] -> Int -> Maybe a
f [Int]
rows Int
y [Int]
cols Int
x of
            Maybe a
Nothing -> Maybe (a, Int)
forall a. Maybe a
Nothing
            Just a
z -> (a, Int) -> Maybe (a, Int)
forall a. a -> Maybe a
Just (a
z, Int
x)
        res :: Maybe Size
res = case Direction
dir of
            Direction
DirLeft -> ([Int] -> Int -> [Int] -> Int -> Maybe Int) -> Maybe Size
forall {b}.
([Int] -> Int -> [Int] -> Int -> Maybe b) -> Maybe (Int, b)
horiz [Int] -> Int -> [Int] -> Int -> Maybe Int
forall {t :: * -> *} {a} {a}.
(Foldable t, Ord a, Eq a) =>
[a] -> a -> t a -> a -> Maybe a
goLeft
            Direction
DirRight -> ([Int] -> Int -> [Int] -> Int -> Maybe Int) -> Maybe Size
forall {b}.
([Int] -> Int -> [Int] -> Int -> Maybe b) -> Maybe (Int, b)
horiz [Int] -> Int -> [Int] -> Int -> Maybe Int
forall {t :: * -> *} {a} {a}.
(Foldable t, Ord a, Eq a) =>
[a] -> a -> t a -> a -> Maybe a
goRight
            Direction
DirUp -> ([Int] -> Int -> [Int] -> Int -> Maybe Int) -> Maybe Size
forall {a}.
([Int] -> Int -> [Int] -> Int -> Maybe a) -> Maybe (a, Int)
vert [Int] -> Int -> [Int] -> Int -> Maybe Int
forall {t :: * -> *} {a} {a}.
(Foldable t, Ord a, Eq a) =>
[a] -> a -> t a -> a -> Maybe a
goLeft
            Direction
DirDown -> ([Int] -> Int -> [Int] -> Int -> Maybe Int) -> Maybe Size
forall {a}.
([Int] -> Int -> [Int] -> Int -> Maybe a) -> Maybe (a, Int)
vert [Int] -> Int -> [Int] -> Int -> Maybe Int
forall {t :: * -> *} {a} {a}.
(Foldable t, Ord a, Eq a) =>
[a] -> a -> t a -> a -> Maybe a
goRight
     in -- trace ("result of findNextActiveCell: " ++ show res)
        Maybe Size
res
  where
    goLeft :: [a] -> a -> t a -> a -> Maybe a
goLeft [a]
_ a
_ t a
rows a
a | Bool -> Bool
not (a
a a -> t a -> Bool
forall a. Eq a => a -> t a -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` t a
rows) = Maybe a
forall a. Maybe a
Nothing
    goLeft [a]
cols a
b t a
_ a
_ =
        case [a] -> [a]
forall a. [a] -> [a]
reverse ((a -> Bool) -> [a] -> [a]
forall a. (a -> Bool) -> [a] -> [a]
takeWhile (a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
b) [a]
cols) of
            [] -> Maybe a
forall a. Maybe a
Nothing
            (a
c : [a]
_) -> a -> Maybe a
forall a. a -> Maybe a
Just a
c
    goRight :: [a] -> a -> t a -> a -> Maybe a
goRight [a]
_ a
_ t a
rows a
a | Bool -> Bool
not (a
a a -> t a -> Bool
forall a. Eq a => a -> t a -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` t a
rows) = Maybe a
forall a. Maybe a
Nothing
    goRight [a]
cols a
a t a
_ a
_ =
        case (a -> Bool) -> [a] -> [a]
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (a
a a -> a -> Bool
forall a. Ord a => a -> a -> Bool
>=) [a]
cols of
            [] -> Maybe a
forall a. Maybe a
Nothing
            (a
b : [a]
_) -> a -> Maybe a
forall a. a -> Maybe a
Just a
b

tableWidgetDeleteRow :: Int -> TableWidget -> TableWidget
tableWidgetDeleteRow :: Int -> TableWidget -> TableWidget
tableWidgetDeleteRow Int
n TableWidget
tbw =
    let rows :: [Row]
rows = TableWidget -> [Row]
tbw_rows TableWidget
tbw
        rows' :: [Row]
rows' = Int -> [Row] -> [Row]
forall a. Int -> [a] -> [a]
deleteAt Int
n [Row]
rows
        pos' :: Maybe Size
pos' =
            case TableWidget -> Maybe Size
tbw_pos TableWidget
tbw of
                Maybe Size
Nothing -> Maybe Size
forall a. Maybe a
Nothing
                Just (Int
row, Int
col) ->
                    let row' :: Int
row' = Int -> Int -> Int
forall a. Ord a => a -> a -> a
min Int
row ([Row] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Row]
rows' Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
                     in if Int
row' Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0
                            then Size -> Maybe Size
forall a. a -> Maybe a
Just (Int
row', Int
col)
                            else Maybe Size
forall a. Maybe a
Nothing
     in TableWidget
tbw {tbw_rows = rows', tbw_pos = pos'}

--
-- BorderWidget
--

--
-- Selection Widget
--

--
-- Utility functions
--

-- | Join a list by some delimiter
joinLists :: [[a]] -> [a] -> [a]
joinLists :: forall a. [[a]] -> [a] -> [a]
joinLists [[a]]
l [a]
s = if ([[a]] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [[a]]
l) then [] else ([a] -> [a] -> [a]) -> [[a]] -> [a]
forall a. (a -> a -> a) -> [a] -> a
forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldr1 (\[a]
x -> \[a]
y -> [a]
x [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ [a]
s [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ [a]
y) [[a]]
l

-- | Split a list by some delimiter
splitList :: (Eq a) => [a] -> [a] -> [[a]]
splitList :: forall a. Eq a => [a] -> [a] -> [[a]]
splitList [a]
d [a]
l =
    ([a] -> Maybe ([a], [a])) -> [a] -> [[a]]
forall b a. (b -> Maybe (a, b)) -> b -> [a]
unfoldr
        ( \[a]
x ->
            if ([a] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [a]
x)
                then Maybe ([a], [a])
forall a. Maybe a
Nothing
                else ([a], [a]) -> Maybe ([a], [a])
forall a. a -> Maybe a
Just (([a], [a]) -> Maybe ([a], [a])) -> ([a], [a]) -> Maybe ([a], [a])
forall a b. (a -> b) -> a -> b
$ [a] -> [a] -> [a] -> ([a], [a])
forall {a}. Eq a => [a] -> [a] -> [a] -> ([a], [a])
nextToken [a]
d [] (([a], [a]) -> [a]
forall a b. (a, b) -> b
snd (([a], [a]) -> [a]) -> ([a], [a]) -> [a]
forall a b. (a -> b) -> a -> b
$ Int -> [a] -> ([a], [a])
forall a. Int -> [a] -> ([a], [a])
splitAt ([a] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
d) [a]
x)
        )
        ([a]
d [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ [a]
l)
  where
    nextToken :: [a] -> [a] -> [a] -> ([a], [a])
nextToken [a]
_ [a]
r [] = ([a]
r, [])
    nextToken [a]
e [a]
r m :: [a]
m@(a
h : [a]
t)
        | ([a]
e [a] -> [a] -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` [a]
m) = ([a]
r, [a]
m)
        | Bool
otherwise = [a] -> [a] -> [a] -> ([a], [a])
nextToken [a]
e ([a]
r [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ [a
h]) [a]
t

listReplace :: [a] -> a -> Int -> [a]
listReplace :: forall a. [a] -> a -> Int -> [a]
listReplace [a]
l a
a Int
i =
    case Int -> [a] -> ([a], [a])
forall a. Int -> [a] -> ([a], [a])
splitAt Int
i [a]
l of
        ([a]
_, []) ->
            String -> [a]
forall a. HasCallStack => String -> a
error
                ( String
"listReplace: index to large. index="
                    String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
i
                    String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
", length="
                    String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show ([a] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
l)
                )
        ([], [a]
_)
            | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 ->
                String -> [a]
forall a. HasCallStack => String -> a
error
                    ( String
"listReplace: negative index. index="
                        String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
i
                    )
        ([a]
xs, (a
_ : [a]
ys)) -> [a]
xs [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ (a
a a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
ys)

-- alignRows :: [[String]] -> Char -> String -> [String]
alignRows :: [[[a]]] -> a -> [a] -> [[a]]
alignRows :: forall a. [[[a]]] -> a -> [a] -> [[a]]
alignRows [[[a]]]
rows a
fill [a]
delim =
    let widths :: [Int]
widths = ([[a]] -> [Int] -> [Int]) -> [Int] -> [[[a]]] -> [Int]
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr [[a]] -> [Int] -> [Int]
forall a. [[a]] -> [Int] -> [Int]
maxWidths (Int -> [Int]
forall a. a -> [a]
repeat Int
0) [[[a]]]
rows
     in ([[a]] -> [a]) -> [[[a]]] -> [[a]]
forall a b. (a -> b) -> [a] -> [b]
map ([Int] -> [[a]] -> [a]
alignRow [Int]
widths) [[[a]]]
rows
  where
    maxWidths :: [[a]] -> [Int] -> [Int]
    maxWidths :: forall a. [[a]] -> [Int] -> [Int]
maxWidths [[a]]
row [Int]
acc = (Size -> Int) -> [Size] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map ((Int -> Int -> Int) -> Size -> Int
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Int -> Int -> Int
forall a. Ord a => a -> a -> a
max) ([Int] -> [Int] -> [Size]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int]
acc (([a] -> Int) -> [[a]] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map [a] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [[a]]
row))
    alignRow :: [Int] -> [[a]] -> [a]
alignRow [Int]
widths [[a]]
row = ((Int, [a]) -> [a]) -> [(Int, [a])] -> [a]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ((Int -> [a] -> [a]) -> (Int, [a]) -> [a]
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Int -> [a] -> [a]
alignCell) ([Int] -> [[a]] -> [(Int, [a])]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int]
widths [[a]]
row)
    alignCell :: Int -> [a] -> [a]
alignCell Int
width [a]
cell =
        let diff :: Int
diff = Int
width Int -> Int -> Int
forall a. Num a => a -> a -> a
- [a] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
cell
         in [a]
cell [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ (Int -> [a] -> [a]
forall a. Int -> [a] -> [a]
take Int
diff ([a] -> [a]) -> [a] -> [a]
forall a b. (a -> b) -> a -> b
$ a -> [a]
forall a. a -> [a]
repeat a
fill) [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ [a]
delim

align :: HAlignment -> Int -> a -> [a] -> [a]
align :: forall a. HAlignment -> Int -> a -> [a] -> [a]
align HAlignment
a Int
w a
f [a]
l =
    let space :: Int
space = Int
w Int -> Int -> Int
forall a. Num a => a -> a -> a
- [a] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
l
     in case HAlignment
a of
            HAlignment
AlignLeft -> [a]
l [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ (Int -> [a]
fill Int
space)
            HAlignment
AlignRight -> (Int -> [a]
fill Int
space) [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ [a]
l
            HAlignment
AlignCenter ->
                let left :: Int
left = Int
space Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
2
                    right :: Int
right = Int
left Int -> Int -> Int
forall a. Num a => a -> a -> a
+ (Int
space Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Int
2)
                 in Int -> [a]
fill Int
left [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ [a]
l [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ Int -> [a]
fill Int
right
  where
    fill :: Int -> [a]
fill Int
n = Int -> [a] -> [a]
forall a. Int -> [a] -> [a]
take Int
n (a -> [a]
forall a. a -> [a]
repeat a
f)

deleteAt :: Int -> [a] -> [a]
deleteAt :: forall a. Int -> [a] -> [a]
deleteAt Int
n [a]
l =
    if Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0 Bool -> Bool -> Bool
&& Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< [a] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
l
        then
            let ([a]
a, [a]
b) = Int -> [a] -> ([a], [a])
forall a. Int -> [a] -> ([a], [a])
splitAt Int
n [a]
l
             in case [a]
b of
                    [] -> String -> [a]
forall a. HasCallStack => String -> a
error String
"deleteAt: impossible"
                    (a
_ : [a]
rest) -> [a]
a [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ [a]
rest
        else String -> [a]
forall a. HasCallStack => String -> a
error (String
"deleteAt: illegal index: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
n)