{- |
Copyright: (c) 2018-2019 Kowainik
SPDX-License-Identifier: MPL-2.0
Maintainer: Kowainik <xrom.xkov@gmail.com>

@Brick@ library helper functions to group checkbox elements inside the form.
This is not going to be the part of the library itself, so we will have it in
our own libraries. See relevant discussion under the corresponding issue:

* https://github.com/jtdaugherty/brick/issues/190
-}

module Summoner.Tui.GroupBorder
       ( groupBorder
       , (|>)
       ) where

import Brick (Edges (..), Padding (Max), Widget, padRight, vLimit, (<+>), (<=>))
import Brick.Forms (FormFieldState, (@@=))
import Brick.Widgets.Border (hBorder, hBorderWithLabel, joinableBorder, vBorder)

import Summoner.Tui.Widget (borderLabel, borderName)


-- | Create a pair of elements.
infix 4 |>
(|>) :: Int -> a -> (Int, a)
|> :: Int -> a -> (Int, a)
(|>) = (,)
{-# INLINE (|>) #-}


{- |
This function unites any amount of the form elements under the one group in
bourders with the given group name. Intended to be used for joining check-boxes
together, but any other elemens of the form will work the same way.

__Example:__

@
┌─────────────────Form───────────────────┐
│                                        │
│┌──────────────Accounts────────────────┐│
││[ ] user1                             ││
││[ ] User2                             ││
│└──────────────────────────────────────┘│
└────────────────────────────────────────┘
@

**Note:** on an empty list it doesn't create any group or border.
-}
groupBorder :: String -> [(Int, s -> FormFieldState s e n)] -> [s -> FormFieldState s e n]
groupBorder :: String
-> [(Int, s -> FormFieldState s e n)]
-> [s -> FormFieldState s e n]
groupBorder groupName :: String
groupName  = \case
    []       -> []
    [x :: (Int, s -> FormFieldState s e n)
x]      -> [String
-> (Int, s -> FormFieldState s e n) -> s -> FormFieldState s e n
forall s e n.
String
-> (Int, s -> FormFieldState s e n) -> s -> FormFieldState s e n
groupAllBorders String
groupName (Int, s -> FormFieldState s e n)
x]
    (x :: (Int, s -> FormFieldState s e n)
x:y :: (Int, s -> FormFieldState s e n)
y:xs :: [(Int, s -> FormFieldState s e n)]
xs) -> let (mid :: [(Int, s -> FormFieldState s e n)]
mid, l :: (Int, s -> FormFieldState s e n)
l) = (NonEmpty (Int, s -> FormFieldState s e n)
-> [(Int, s -> FormFieldState s e n)]
forall (f :: * -> *) a. IsNonEmpty f a [a] "init" => f a -> [a]
init (NonEmpty (Int, s -> FormFieldState s e n)
 -> [(Int, s -> FormFieldState s e n)])
-> NonEmpty (Int, s -> FormFieldState s e n)
-> [(Int, s -> FormFieldState s e n)]
forall a b. (a -> b) -> a -> b
$ (Int, s -> FormFieldState s e n)
y (Int, s -> FormFieldState s e n)
-> [(Int, s -> FormFieldState s e n)]
-> NonEmpty (Int, s -> FormFieldState s e n)
forall a. a -> [a] -> NonEmpty a
:| [(Int, s -> FormFieldState s e n)]
xs, NonEmpty (Int, s -> FormFieldState s e n)
-> (Int, s -> FormFieldState s e n)
forall (f :: * -> *) a. IsNonEmpty f a a "last" => f a -> a
last (NonEmpty (Int, s -> FormFieldState s e n)
 -> (Int, s -> FormFieldState s e n))
-> NonEmpty (Int, s -> FormFieldState s e n)
-> (Int, s -> FormFieldState s e n)
forall a b. (a -> b) -> a -> b
$ (Int, s -> FormFieldState s e n)
y (Int, s -> FormFieldState s e n)
-> [(Int, s -> FormFieldState s e n)]
-> NonEmpty (Int, s -> FormFieldState s e n)
forall a. a -> [a] -> NonEmpty a
:| [(Int, s -> FormFieldState s e n)]
xs) in
        String
-> (Int, s -> FormFieldState s e n) -> s -> FormFieldState s e n
forall s e n.
String
-> (Int, s -> FormFieldState s e n) -> s -> FormFieldState s e n
groupBorderTop String
groupName (Int, s -> FormFieldState s e n)
x (s -> FormFieldState s e n)
-> [s -> FormFieldState s e n] -> [s -> FormFieldState s e n]
forall a. a -> [a] -> [a]
: ((Int, s -> FormFieldState s e n) -> s -> FormFieldState s e n)
-> [(Int, s -> FormFieldState s e n)]
-> [s -> FormFieldState s e n]
forall a b. (a -> b) -> [a] -> [b]
map (Int, s -> FormFieldState s e n) -> s -> FormFieldState s e n
forall s e n.
(Int, s -> FormFieldState s e n) -> s -> FormFieldState s e n
groupBorderMid [(Int, s -> FormFieldState s e n)]
mid [s -> FormFieldState s e n]
-> [s -> FormFieldState s e n] -> [s -> FormFieldState s e n]
forall a. [a] -> [a] -> [a]
++ [(Int, s -> FormFieldState s e n) -> s -> FormFieldState s e n
forall s e n.
(Int, s -> FormFieldState s e n) -> s -> FormFieldState s e n
groupBorderBottom (Int, s -> FormFieldState s e n)
l]

-- | Creates the top border with the group name.
groupBorderTop :: String -> (Int, s -> FormFieldState s e n) -> (s -> FormFieldState s e n)
groupBorderTop :: String
-> (Int, s -> FormFieldState s e n) -> s -> FormFieldState s e n
groupBorderTop groupName :: String
groupName (i :: Int
i, f :: s -> FormFieldState s e n
f) =
    ( Int -> Widget n -> Widget n
forall n. Int -> Widget n -> Widget n
vLimit Int
i
    (Widget n -> Widget n)
-> (Widget n -> Widget n) -> Widget n -> Widget n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Widget n
forall n. Widget n
tl Widget n -> Widget n -> Widget n
forall n. Widget n -> Widget n -> Widget n
<=> Widget n
forall n. Widget n
vBorder) Widget n -> Widget n -> Widget n
forall n. Widget n -> Widget n -> Widget n
<+>)
    (Widget n -> Widget n)
-> (Widget n -> Widget n) -> Widget n -> Widget n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Widget n -> Widget n -> Widget n
forall n. Widget n -> Widget n -> Widget n
<+> (Widget n
forall n. Widget n
tr Widget n -> Widget n -> Widget n
forall n. Widget n -> Widget n -> Widget n
<=> Widget n
forall n. Widget n
vBorder))
    (Widget n -> Widget n)
-> (Widget n -> Widget n) -> Widget n -> Widget n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Widget n -> Widget n
forall n. Widget n -> Widget n
hBorderWithLabel (String -> Widget n
forall n. String -> Widget n
borderName String
groupName) Widget n -> Widget n -> Widget n
forall n. Widget n -> Widget n -> Widget n
<=>)
    ) (Widget n -> Widget n)
-> (s -> FormFieldState s e n) -> s -> FormFieldState s e n
forall n s e.
(Widget n -> Widget n)
-> (s -> FormFieldState s e n) -> s -> FormFieldState s e n
@@= s -> FormFieldState s e n
f

-- | Creates the bottom border of the group.
groupBorderBottom :: (Int, s -> FormFieldState s e n) -> (s -> FormFieldState s e n)
groupBorderBottom :: (Int, s -> FormFieldState s e n) -> s -> FormFieldState s e n
groupBorderBottom (i :: Int
i, f :: s -> FormFieldState s e n
f) =
    ( Int -> Widget n -> Widget n
forall n. Int -> Widget n -> Widget n
vLimit Int
i
    (Widget n -> Widget n)
-> (Widget n -> Widget n) -> Widget n -> Widget n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Widget n
forall n. Widget n
vBorder Widget n -> Widget n -> Widget n
forall n. Widget n -> Widget n -> Widget n
<=> Widget n
forall n. Widget n
bl) Widget n -> Widget n -> Widget n
forall n. Widget n -> Widget n -> Widget n
<+>)
    (Widget n -> Widget n)
-> (Widget n -> Widget n) -> Widget n -> Widget n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Widget n -> Widget n -> Widget n
forall n. Widget n -> Widget n -> Widget n
<+> (Widget n
forall n. Widget n
vBorder Widget n -> Widget n -> Widget n
forall n. Widget n -> Widget n -> Widget n
<=> Widget n
forall n. Widget n
br))
    (Widget n -> Widget n)
-> (Widget n -> Widget n) -> Widget n -> Widget n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Widget n -> Widget n -> Widget n
forall n. Widget n -> Widget n -> Widget n
<=> Widget n
forall n. Widget n
hBorder)
    (Widget n -> Widget n)
-> (Widget n -> Widget n) -> Widget n -> Widget n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Padding -> Widget n -> Widget n
forall n. Padding -> Widget n -> Widget n
padRight Padding
Max
    ) (Widget n -> Widget n)
-> (s -> FormFieldState s e n) -> s -> FormFieldState s e n
forall n s e.
(Widget n -> Widget n)
-> (s -> FormFieldState s e n) -> s -> FormFieldState s e n
@@= s -> FormFieldState s e n
f

-- | Creates the left and right borders for the middle elements of the group.
groupBorderMid :: (Int, s -> FormFieldState s e n) -> (s -> FormFieldState s e n)
groupBorderMid :: (Int, s -> FormFieldState s e n) -> s -> FormFieldState s e n
groupBorderMid (i :: Int
i, f :: s -> FormFieldState s e n
f) =
    ( Int -> Widget n -> Widget n
forall n. Int -> Widget n -> Widget n
vLimit Int
i
    (Widget n -> Widget n)
-> (Widget n -> Widget n) -> Widget n -> Widget n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Widget n
forall n. Widget n
vBorder Widget n -> Widget n -> Widget n
forall n. Widget n -> Widget n -> Widget n
<+>)
    (Widget n -> Widget n)
-> (Widget n -> Widget n) -> Widget n -> Widget n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Widget n -> Widget n -> Widget n
forall n. Widget n -> Widget n -> Widget n
<+> Widget n
forall n. Widget n
vBorder)
    (Widget n -> Widget n)
-> (Widget n -> Widget n) -> Widget n -> Widget n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Padding -> Widget n -> Widget n
forall n. Padding -> Widget n -> Widget n
padRight Padding
Max
    ) (Widget n -> Widget n)
-> (s -> FormFieldState s e n) -> s -> FormFieldState s e n
forall n s e.
(Widget n -> Widget n)
-> (s -> FormFieldState s e n) -> s -> FormFieldState s e n
@@= s -> FormFieldState s e n
f

-- | Creates the border around the only one element.
groupAllBorders :: String -> (Int, s -> FormFieldState s e n) -> (s -> FormFieldState s e n)
groupAllBorders :: String
-> (Int, s -> FormFieldState s e n) -> s -> FormFieldState s e n
groupAllBorders groupName :: String
groupName (i :: Int
i, f :: s -> FormFieldState s e n
f) =
    ( Int -> Widget n -> Widget n
forall n. Int -> Widget n -> Widget n
vLimit Int
i
    (Widget n -> Widget n)
-> (Widget n -> Widget n) -> Widget n -> Widget n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Widget n -> Widget n
forall n. String -> Widget n -> Widget n
borderLabel String
groupName
    (Widget n -> Widget n)
-> (Widget n -> Widget n) -> Widget n -> Widget n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Padding -> Widget n -> Widget n
forall n. Padding -> Widget n -> Widget n
padRight Padding
Max
    ) (Widget n -> Widget n)
-> (s -> FormFieldState s e n) -> s -> FormFieldState s e n
forall n s e.
(Widget n -> Widget n)
-> (s -> FormFieldState s e n) -> s -> FormFieldState s e n
@@= s -> FormFieldState s e n
f


-- | Helpers for the correct border lines.
tl, tr, bl, br :: Widget n
tl :: Widget n
tl = Edges Bool -> Widget n
forall n. Edges Bool -> Widget n
joinableBorder (Bool -> Bool -> Bool -> Bool -> Edges Bool
forall a. a -> a -> a -> a -> Edges a
Edges Bool
False Bool
True Bool
False Bool
True)
tr :: Widget n
tr = Edges Bool -> Widget n
forall n. Edges Bool -> Widget n
joinableBorder (Bool -> Bool -> Bool -> Bool -> Edges Bool
forall a. a -> a -> a -> a -> Edges a
Edges Bool
False Bool
True Bool
True Bool
False)
bl :: Widget n
bl = Edges Bool -> Widget n
forall n. Edges Bool -> Widget n
joinableBorder (Bool -> Bool -> Bool -> Bool -> Edges Bool
forall a. a -> a -> a -> a -> Edges a
Edges Bool
True Bool
False Bool
False Bool
True)
br :: Widget n
br = Edges Bool -> Widget n
forall n. Edges Bool -> Widget n
joinableBorder (Bool -> Bool -> Bool -> Bool -> Edges Bool
forall a. a -> a -> a -> a -> Edges a
Edges Bool
True Bool
False Bool
True Bool
False)