{-# LANGUAGE Rank2Types #-}

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

This modules adds necessary functions for Forms and Form fields
that are not covered in @brick@ library.
-}

module Summoner.Tui.Field
       ( strField
       , checkboxField
       , activeCheckboxField
       , radioField
       , disabledAttr
       ) where

import Brick (BrickEvent (..), EventM, Location (..), Widget, clickable, showCursor, str, vBox,
              withAttr, withDefAttr, (<+>))
import Brick.AttrMap (AttrName)
import Brick.Forms (FormField (..), FormFieldState (..), checkboxCustomField, focusedFormInputAttr,
                    radioCustomField)
import Lens.Micro (Lens', lens, (^.))

import qualified Graphics.Vty as V


-- | A form field with a given text value which can not be modified or changed
-- via any events. It is always valid.
strField :: forall s e n . String -> s -> FormFieldState s e n
strField :: String -> s -> FormFieldState s e n
strField t :: String
t _ = $WFormFieldState :: forall b s a e n.
b
-> Lens' s a
-> [FormField a b e n]
-> (Widget n -> Widget n)
-> ([Widget n] -> Widget n)
-> FormFieldState s e n
FormFieldState
    { formFieldState :: ()
formFieldState = ()
    , formFieldLens :: Lens' s ()
formFieldLens = Lens' s ()
fakeLens
    , formFields :: [FormField () () e n]
formFields = []
    , formFieldRenderHelper :: Widget n -> Widget n
formFieldRenderHelper = Widget n -> Widget n
renderString
    , formFieldConcat :: [Widget n] -> Widget n
formFieldConcat = [Widget n] -> Widget n
forall n. [Widget n] -> Widget n
vBox
    }
  where
    -- looool
    fakeLens :: Lens' s ()
    fakeLens :: (() -> f ()) -> s -> f s
fakeLens = (s -> ()) -> (s -> () -> s) -> Lens' s ()
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens (() -> s -> ()
forall a b. a -> b -> a
const ()) (\s :: s
s () -> s
s)

    renderString :: Widget n -> Widget n
    renderString :: Widget n -> Widget n
renderString w :: Widget n
w = String -> Widget n
forall n. String -> Widget n
str String
t Widget n -> Widget n -> Widget n
forall n. Widget n -> Widget n -> Widget n
<+> Widget n
w

{- | Custom checkbox with unique fancy style.

__Example:__

@
⟦✔⟧ Library
⟦ ⟧ Executable
@
-}
checkboxField
    :: (Ord n, Show n)
    => Lens' s Bool -- ^ The state lens for this value.
    -> n            -- ^ The resource name for the input field.
    -> Text         -- ^ The label for the check box, to appear at its right.
    -> s            -- ^ The initial form state.
    -> FormFieldState s e n
checkboxField :: Lens' s Bool -> n -> Text -> s -> FormFieldState s e n
checkboxField = Char
-> Char
-> Char
-> Lens' s Bool
-> n
-> Text
-> s
-> FormFieldState s e n
forall n s e.
(Ord n, Show n) =>
Char
-> Char
-> Char
-> Lens' s Bool
-> n
-> Text
-> s
-> FormFieldState s e n
checkboxCustomField '⟦' '✔' '⟧'

{- | Custom radio button with unique fancy style.

__Example:__

@
❮◆❯ Enable  ❮ ❯ Disable
@
-}
radioField
    :: (Ord n, Show n, Eq a)
    => Lens' s a       -- ^ The state lens for this value.
    -> [(a, n, Text)]  -- ^ The available choices, in order.
    -> s               -- ^ The initial form state.
    -> FormFieldState s e n
radioField :: Lens' s a -> [(a, n, Text)] -> s -> FormFieldState s e n
radioField = Char
-> Char
-> Char
-> Lens' s a
-> [(a, n, Text)]
-> s
-> FormFieldState s e n
forall n a s e.
(Ord n, Show n, Eq a) =>
Char
-> Char
-> Char
-> Lens' s a
-> [(a, n, Text)]
-> s
-> FormFieldState s e n
radioCustomField '❮' '◆' '❯'

-- | Checkbox that can be disabled.
activeCheckboxField
    :: forall n s e . Ord n
    => Lens' s Bool
    -> (s -> n -> Bool)  -- ^ Function should return 'False' if checkbox should be disabled.
    -> n
    -> String  -- ^ The label for the check box, to appear at its right.
    -> s       -- ^ The initial form state.
    -> FormFieldState s e n
activeCheckboxField :: Lens' s Bool
-> (s -> n -> Bool) -> n -> String -> s -> FormFieldState s e n
activeCheckboxField stLens :: Lens' s Bool
stLens isActive :: s -> n -> Bool
isActive name :: n
name label :: String
label initialState :: s
initialState = $WFormFieldState :: forall b s a e n.
b
-> Lens' s a
-> [FormField a b e n]
-> (Widget n -> Widget n)
-> ([Widget n] -> Widget n)
-> FormFieldState s e n
FormFieldState
    { formFieldState :: Bool
formFieldState        = Bool
initVal
    , formFields :: [FormField Bool Bool e n]
formFields            = [FormField Bool Bool e n
checkboxFormField]
    , formFieldLens :: Lens' s Bool
formFieldLens         = Lens' s Bool
stLens
    , formFieldRenderHelper :: Widget n -> Widget n
formFieldRenderHelper = Widget n -> Widget n
forall a. a -> a
id
    , formFieldConcat :: [Widget n] -> Widget n
formFieldConcat       = [Widget n] -> Widget n
forall n. [Widget n] -> Widget n
vBox
    }
  where
    initVal, isEnabled :: Bool
    initVal :: Bool
initVal   = s
initialState s -> Getting Bool s Bool -> Bool
forall s a. s -> Getting a s a -> a
^. Getting Bool s Bool
Lens' s Bool
stLens
    isEnabled :: Bool
isEnabled = s -> n -> Bool
isActive s
initialState n
name

    handleEvent :: BrickEvent n e -> Bool -> EventM n Bool
    handleEvent :: BrickEvent n e -> Bool -> EventM n Bool
handleEvent (MouseDown n :: n
n _ _ _)
        | Bool
isEnabled Bool -> Bool -> Bool
&& n
n n -> n -> Bool
forall a. Eq a => a -> a -> Bool
== n
name = Bool -> EventM n Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Bool -> EventM n Bool) -> (Bool -> Bool) -> Bool -> EventM n Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Bool
not
    handleEvent (VtyEvent (V.EvKey (V.KChar ' ') [])) = Bool -> EventM n Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Bool -> EventM n Bool) -> (Bool -> Bool) -> Bool -> EventM n Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Bool
not
    handleEvent _ = Bool -> EventM n Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure

    checkboxFormField :: FormField Bool Bool e n
    checkboxFormField :: FormField Bool Bool e n
checkboxFormField = FormField :: forall a b e n.
n
-> (b -> Maybe a)
-> Bool
-> (Bool -> b -> Widget n)
-> (BrickEvent n e -> b -> EventM n b)
-> FormField a b e n
FormField
        { formFieldName :: n
formFieldName = n
name
        , formFieldValidate :: Bool -> Maybe Bool
formFieldValidate = Bool -> Maybe Bool
forall a. a -> Maybe a
Just
        , formFieldExternallyValid :: Bool
formFieldExternallyValid = Bool
True
        , formFieldRender :: Bool -> Bool -> Widget n
formFieldRender = Bool -> String -> n -> Bool -> Bool -> Widget n
forall n. Bool -> String -> n -> Bool -> Bool -> Widget n
renderCheckbox Bool
isEnabled String
label n
name
        , formFieldHandleEvent :: BrickEvent n e -> Bool -> EventM n Bool
formFieldHandleEvent = BrickEvent n e -> Bool -> EventM n Bool
handleEvent
        }

-- | Renders checkbox depending on its state.
renderCheckbox :: Bool -> String -> n -> Bool -> Bool -> Widget n
renderCheckbox :: Bool -> String -> n -> Bool -> Bool -> Widget n
renderCheckbox isEnabled :: Bool
isEnabled label :: String
label n :: n
n foc :: Bool
foc val :: Bool
val =
    let addAttr :: Widget n -> Widget n
addAttr = if Bool
foc then AttrName -> Widget n -> Widget n
forall n. AttrName -> Widget n -> Widget n
withDefAttr AttrName
focusedFormInputAttr else Widget n -> Widget n
forall a. a -> a
id
        csr :: Widget n -> Widget n
csr = if Bool
foc then n -> Location -> Widget n -> Widget n
forall n. n -> Location -> Widget n -> Widget n
showCursor n
n ((Int, Int) -> Location
Location (1,0)) else Widget n -> Widget n
forall a. a -> a
id
    in if Bool
isEnabled
           then n -> Widget n -> Widget n
forall n. n -> Widget n -> Widget n
clickable n
n (Widget n -> Widget n) -> Widget n -> Widget n
forall a b. (a -> b) -> a -> b
$ Widget n -> Widget n
forall n. Widget n -> Widget n
addAttr (Widget n -> Widget n) -> Widget n -> Widget n
forall a b. (a -> b) -> a -> b
$ Widget n -> Widget n
csr (Widget n -> Widget n) -> Widget n -> Widget n
forall a b. (a -> b) -> a -> b
$ String -> Widget n
forall n. String -> Widget n
str (String -> Widget n) -> String -> Widget n
forall a b. (a -> b) -> a -> b
$
               "⟦" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> (if Bool
val then "✔" else " ") String -> String -> String
forall a. Semigroup a => a -> a -> a
<> "⟧" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> " " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
label
           else AttrName -> Widget n -> Widget n
forall n. AttrName -> Widget n -> Widget n
withAttr AttrName
disabledAttr (Widget n -> Widget n) -> Widget n -> Widget n
forall a b. (a -> b) -> a -> b
$ String -> Widget n
forall n. String -> Widget n
str (String -> Widget n) -> String -> Widget n
forall a b. (a -> b) -> a -> b
$ "⟦ ⟧ " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
label

-- | Attribute for disabled checkboxes.
disabledAttr :: AttrName
disabledAttr :: AttrName
disabledAttr = "disabled"