{-# LANGUAGE RankNTypes, FlexibleContexts #-}
module Parameters where
import UI.Attributes
import Brick
import Brick.Widgets.Center
import Brick.Forms
import DeckHandling
import Data.Maybe
import Data.Char (isDigit)
import Data.Text (pack)
import Lens.Micro.Platform
import States
import Text.Read (readMaybe)
import UI.BrickHelpers
import qualified Data.Text as T
import qualified Graphics.Vty as V

mkParameterForm :: Int -> Parameters -> Form Parameters e Name
mkParameterForm :: forall e. Int -> Parameters -> Form Parameters e Name
mkParameterForm Int
n Parameters
ps =
  let label :: String -> Widget n -> Widget n
label String
s Widget n
w = forall n. Padding -> Widget n -> Widget n
padBottom (Int -> Padding
Pad Int
1) forall a b. (a -> b) -> a -> b
$ forall n. Padding -> Widget n -> Widget n
padRight (Int -> Padding
Pad Int
2) (forall n. String -> Widget n
strWrap String
s) forall n. Widget n -> Widget n -> Widget n
<+> Widget n
w
      form :: Form Parameters e Name
form = forall s e n. [s -> FormFieldState s e n] -> s -> Form s e n
newForm
        [ forall s e.
Int -> Lens' s (Chunk, Int) -> s -> FormFieldState s e Name
chunkSubsetField Int
n (Int -> Lens' Parameters (Chunk, Int)
chunkSubsetLens Int
n)
        , forall {n}. String -> Widget n -> Widget n
label String
"Shuffle the deck?" forall n s e.
(Widget n -> Widget n)
-> (s -> FormFieldState s e n) -> s -> FormFieldState s e n
@@= forall n s e.
(Ord n, Show n) =>
Bool -> Lens' s Bool -> n -> String -> s -> FormFieldState s e n
yesnoField Bool
True Lens' Parameters Bool
pShuffle Name
ShuffleField String
""
        , forall {n}. String -> Widget n -> Widget n
label String
"Review mode?" forall n s e.
(Widget n -> Widget n)
-> (s -> FormFieldState s e n) -> s -> FormFieldState s e n
@@= forall n s e.
(Ord n, Show n) =>
Bool -> Lens' s Bool -> n -> String -> s -> FormFieldState s e n
yesnoField Bool
True Lens' Parameters Bool
pReviewMode Name
ReviewModeField String
""
        , forall n. Widget n -> Widget n
hCenter forall n s e.
(Widget n -> Widget n)
-> (s -> FormFieldState s e n) -> s -> FormFieldState s e n
@@= forall n s e.
(Ord n, Show n) =>
Lens' s Bool -> n -> String -> s -> FormFieldState s e n
okField Lens' Parameters Bool
pOk Name
ParametersOkField String
"Ok"
        ] Parameters
ps
  in forall n s e. Eq n => n -> Form s e n -> Form s e n
setFormFocus Name
ParametersOkField forall {e}. Form Parameters e Name
form

chunkSubsetLens :: Int -> Lens' Parameters (Chunk, Int)
chunkSubsetLens :: Int -> Lens' Parameters (Chunk, Int)
chunkSubsetLens Int
n = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens Parameters -> (Chunk, Int)
getter Parameters -> (Chunk, Int) -> Parameters
setter
  where getter :: Parameters -> (Chunk, Int)
getter Parameters
ps = (Parameters
psforall s a. s -> Getting a s a -> a
^.Lens' Parameters Chunk
pChunk, forall a. a -> Maybe a -> a
fromMaybe Int
n (Parameters
psforall s a. s -> Getting a s a -> a
^.Lens' Parameters (Maybe Int)
pSubset))
        setter :: Parameters -> (Chunk, Int) -> Parameters
setter Parameters
ps (Chunk
c, Int
int) = Parameters
ps forall a b. a -> (a -> b) -> b
& Lens' Parameters Chunk
pChunkforall s t a b. ASetter s t a b -> b -> s -> t
.~Chunk
c forall a b. a -> (a -> b) -> b
& Lens' Parameters (Maybe Int)
pSubset forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Int
int

chunkSubsetField :: Int -> Lens' s (Chunk, Int) -> s -> FormFieldState s e Name
chunkSubsetField :: forall s e.
Int -> Lens' s (Chunk, Int) -> s -> FormFieldState s e Name
chunkSubsetField Int
capacity Lens' s (Chunk, Int)
stLens s
initialState = 
  let (Chunk
initChunk, Int
initInt) = s
initialState forall s a. s -> Getting a s a -> a
^. Lens' s (Chunk, Int)
stLens

      handleChunkEvent1 :: BrickEvent n e -> EventM n (Chunk, Int) ()
      handleChunkEvent1 :: forall n e. BrickEvent n e -> EventM n (Chunk, Int) ()
handleChunkEvent1 (VtyEvent Event
ev) = do
        s :: (Chunk, Int)
s@(c :: Chunk
c@(Chunk Int
i Int
n), Int
int) <- forall s (m :: * -> *). MonadState s m => m s
get
        case Event
ev of
          V.EvKey (V.KChar Char
c) [] | Char -> Bool
isDigit Char
c -> do 
            let i' :: Int
i' = forall a. Read a => String -> a
read (forall a. Show a => a -> String
show Int
i forall a. [a] -> [a] -> [a]
++ [Char
c])
            forall s (m :: * -> *). MonadState s m => s -> m ()
put forall a b. (a -> b) -> a -> b
$ if Int
i' forall a. Ord a => a -> a -> Bool
<= Int
n Bool -> Bool -> Bool
|| Int
n forall a. Eq a => a -> a -> Bool
== Int
0 then (Int -> Int -> Chunk
Chunk Int
i' Int
n, Chunk -> Int
getSizeOfChunk (Int -> Int -> Chunk
Chunk Int
i' Int
n)) else (Int -> Int -> Chunk
Chunk Int
n Int
n, Chunk -> Int
getSizeOfChunk (Int -> Int -> Chunk
Chunk Int
n Int
n))
          V.EvKey Key
V.KBS [] -> do
            let calcNew :: a -> a
calcNew a
x = if forall (t :: * -> *) a. Foldable t => t a -> Bool
null (forall a. Show a => a -> String
show a
x) then a
0 else forall a. a -> Maybe a -> a
fromMaybe a
0 (forall a. Read a => String -> Maybe a
readMaybe (forall a. [a] -> [a]
init (forall a. Show a => a -> String
show a
x)))
            forall s (m :: * -> *). MonadState s m => s -> m ()
put (Int -> Int -> Chunk
Chunk (forall {a} {a}. (Show a, Num a, Read a) => a -> a
calcNew Int
i) Int
n, Int
int)
          Event
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
      handleChunkEvent1 BrickEvent n e
_ = forall (m :: * -> *) a. Monad m => a -> m a
return ()

      handleChunkEvent2 :: BrickEvent n e -> EventM n (Chunk, Int) ()
      handleChunkEvent2 :: forall n e. BrickEvent n e -> EventM n (Chunk, Int) ()
handleChunkEvent2 (VtyEvent Event
ev) = do 
        s :: (Chunk, Int)
s@(c :: Chunk
c@(Chunk Int
i Int
n), Int
int) <- forall s (m :: * -> *). MonadState s m => m s
get
        case Event
ev of
          V.EvKey (V.KChar Char
c) [] | Char -> Bool
isDigit Char
c -> do
            let n' :: Int
n' = forall a. Read a => String -> a
read (forall a. Show a => a -> String
show Int
n forall a. [a] -> [a] -> [a]
++ [Char
c])
                i' :: Int
i' = if Int
i forall a. Ord a => a -> a -> Bool
<= Int
n' Bool -> Bool -> Bool
|| Int
n' forall a. Eq a => a -> a -> Bool
== Int
0 then Int
i else Int
n'
            forall s (m :: * -> *). MonadState s m => s -> m ()
put forall a b. (a -> b) -> a -> b
$ if Int
n' forall a. Ord a => a -> a -> Bool
<= Int
capacity then (Int -> Int -> Chunk
Chunk Int
i' Int
n', Chunk -> Int
getSizeOfChunk (Int -> Int -> Chunk
Chunk Int
i' Int
n')) else (Int -> Int -> Chunk
Chunk Int
i Int
capacity, Chunk -> Int
getSizeOfChunk (Int -> Int -> Chunk
Chunk Int
i Int
capacity))
          V.EvKey Key
V.KBS [] -> do
            let calcNew :: a -> a
calcNew a
x = if forall (t :: * -> *) a. Foldable t => t a -> Bool
null (forall a. Show a => a -> String
show a
x) then a
0 else forall a. a -> Maybe a -> a
fromMaybe a
0 (forall a. Read a => String -> Maybe a
readMaybe (forall a. [a] -> [a]
init (forall a. Show a => a -> String
show a
x)))
                newN :: Int
newN = forall {a} {a}. (Show a, Num a, Read a) => a -> a
calcNew Int
n
                newI :: Int
newI = if Int
i forall a. Ord a => a -> a -> Bool
<= Int
newN Bool -> Bool -> Bool
|| Int
newN forall a. Eq a => a -> a -> Bool
== Int
0 then Int
i else Int
newN
            forall s (m :: * -> *). MonadState s m => s -> m ()
put (Int -> Int -> Chunk
Chunk Int
newI Int
newN, Int
int)
          Event
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
      handleChunkEvent2 BrickEvent n e
_ = forall (m :: * -> *) a. Monad m => a -> m a
return ()

      handleSubsetEvent :: BrickEvent n e -> EventM n (Chunk, Int) ()
      handleSubsetEvent :: forall n e. BrickEvent n e -> EventM n (Chunk, Int) ()
handleSubsetEvent (VtyEvent Event
ev) = do
        s :: (Chunk, Int)
s@(ch :: Chunk
ch@(Chunk Int
i Int
n), Int
int) <- forall s (m :: * -> *). MonadState s m => m s
get
        let bound :: Int
bound = Chunk -> Int
getSizeOfChunk Chunk
ch in
          case Event
ev of
          V.EvKey (V.KChar Char
c) [] | Char -> Bool
isDigit Char
c -> do
            let newValue :: Int
newValue = forall a. Read a => String -> a
read (forall a. Show a => a -> String
show Int
int forall a. [a] -> [a] -> [a]
++ [Char
c])
                int' :: Int
int' = forall a. Ord a => a -> a -> a
min Int
newValue Int
bound
            forall s (m :: * -> *). MonadState s m => s -> m ()
put (Chunk
ch, Int
int')
          V.EvKey Key
V.KBS [] -> do
            let int' :: Int
int' = case forall a. Show a => a -> String
show Int
int of
                            String
"" -> Int
0
                            String
xs -> forall a. a -> Maybe a -> a
fromMaybe Int
0 (forall a. Read a => String -> Maybe a
readMaybe (forall a. [a] -> [a]
init String
xs))
            forall s (m :: * -> *). MonadState s m => s -> m ()
put (Chunk
ch, Int
int')
          Event
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
      handleSubsetEvent BrickEvent n e
_ = forall (m :: * -> *) a. Monad m => a -> m a
return ()

      renderChunk1 :: Bool -> (Chunk, Int) -> Widget Name
      renderChunk1 :: Bool -> (Chunk, Int) -> Widget Name
renderChunk1 Bool
foc (Chunk Int
i Int
n, Int
_) = 
        let addAttr :: Widget n -> Widget n
addAttr = if Bool
foc then forall n. AttrName -> Widget n -> Widget n
withDefAttr AttrName
focusedFormInputAttr else forall a. a -> a
id
            csr :: t a -> Widget Name -> Widget Name
csr t a
x = if Bool
foc then forall n. n -> Location -> Widget n -> Widget n
showCursor Name
ChunkField1 ((Int, Int) -> Location
Location (forall (t :: * -> *) a. Foldable t => t a -> Int
length t a
x,Int
0)) else forall a. a -> a
id
            val' :: a -> String
val' a
0 = String
""
            val' a
x = forall a. Show a => a -> String
show a
x
          in forall n. Widget n -> Widget n
addAttr (forall {t :: * -> *} {a}.
Foldable t =>
t a -> Widget Name -> Widget Name
csr (forall {a}. (Eq a, Num a, Show a) => a -> String
val' Int
i) (forall n. String -> Widget n
str (forall {a}. (Eq a, Num a, Show a) => a -> String
val' Int
i))) forall n. Widget n -> Widget n -> Widget n
<+> forall n. String -> Widget n
str String
"/"

      renderChunk2 :: Bool -> (Chunk, Int) -> Widget Name
      renderChunk2 :: Bool -> (Chunk, Int) -> Widget Name
renderChunk2 Bool
foc (Chunk Int
i Int
n, Int
_) = 
        let addAttr :: Widget n -> Widget n
addAttr = if Bool
foc then forall n. AttrName -> Widget n -> Widget n
withDefAttr AttrName
focusedFormInputAttr else forall a. a -> a
id
            csr :: t a -> Widget Name -> Widget Name
csr t a
x = if Bool
foc then forall n. n -> Location -> Widget n -> Widget n
showCursor Name
ChunkField2 ((Int, Int) -> Location
Location (forall (t :: * -> *) a. Foldable t => t a -> Int
length t a
x,Int
0)) else forall a. a -> a
id
            val' :: a -> String
val' a
0 = String
""
            val' a
x = forall a. Show a => a -> String
show a
x
          in forall n. Widget n -> Widget n
addAttr (forall {t :: * -> *} {a}.
Foldable t =>
t a -> Widget Name -> Widget Name
csr (forall {a}. (Eq a, Num a, Show a) => a -> String
val' Int
n) (forall n. String -> Widget n
str (forall {a}. (Eq a, Num a, Show a) => a -> String
val' Int
n)))

      customConcat :: [Widget Name] -> Widget Name
      customConcat :: [Widget Name] -> Widget Name
customConcat [Widget Name
chunk1, Widget Name
chunk2, Widget Name
subset] = 
        (forall n. String -> Widget n
str String
"Select chunk:" forall n. Widget n -> Widget n -> Widget n
<+> forall n. Char -> Widget n
hFill Char
' ' forall n. Widget n -> Widget n -> Widget n
<+> Widget Name
chunk1 forall n. Widget n -> Widget n -> Widget n
<+> Widget Name
chunk2) 
        forall n. Widget n -> Widget n -> Widget n
<=>
        forall n. String -> Widget n
str String
" "
        forall n. Widget n -> Widget n -> Widget n
<=>
        (forall n. String -> Widget n
str String
"Number of cards:" forall n. Widget n -> Widget n -> Widget n
<+> forall n. Char -> Widget n
hFill Char
' ' forall n. Widget n -> Widget n -> Widget n
<+> Widget Name
subset)
        forall n. Widget n -> Widget n -> Widget n
<=>
        forall n. String -> Widget n
str String
" "
      customConcat [Widget Name]
_ = forall a. HasCallStack => String -> a
error String
"chunkSubsetField form field concatenation has gone wrong"

      getSizeOfChunk :: Chunk -> Int
      getSizeOfChunk :: Chunk -> Int
getSizeOfChunk (Chunk Int
i Int
n) = 
        if Int
i forall a. Ord a => a -> a -> Bool
>= Int
1 Bool -> Bool -> Bool
&& Int
n forall a. Ord a => a -> a -> Bool
>= Int
1 Bool -> Bool -> Bool
&& Int
i forall a. Ord a => a -> a -> Bool
<= Int
n
          then forall (t :: * -> *) a. Foldable t => t a -> Int
length (forall a. Int -> [a] -> [[a]]
splitIntoNChunks Int
n [Int
1..Int
capacity] forall a. [a] -> Int -> a
!! (Int
iforall a. Num a => a -> a -> a
-Int
1))
          else Int
capacity

      renderSubset :: Bool -> (Chunk, Int) -> Widget Name
      renderSubset :: Bool -> (Chunk, Int) -> Widget Name
renderSubset Bool
foc (Chunk
c, Int
value) = 
        let cardsInChunk :: Int
cardsInChunk = Chunk -> Int
getSizeOfChunk Chunk
c
        in forall n. Int -> String -> n -> Bool -> Int -> Widget n
renderNaturalNumber Int
cardsInChunk (String
"/" forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show Int
cardsInChunk) Name
SubsetField Bool
foc Int
value
      
      validateChunk :: (Chunk, b) -> Maybe (Chunk, b)
validateChunk (c :: Chunk
c@(Chunk Int
i Int
n), b
int) = if Int
i forall a. Ord a => a -> a -> Bool
>= Int
1 Bool -> Bool -> Bool
&& Int
n forall a. Ord a => a -> a -> Bool
>= Int
1 Bool -> Bool -> Bool
&& Int
i forall a. Ord a => a -> a -> Bool
<= Int
n then forall a. a -> Maybe a
Just (Chunk
c, b
int) else forall a. Maybe a
Nothing
      validateSubset :: a -> Maybe a
validateSubset = forall a. a -> Maybe a
Just

  in FormFieldState { formFieldState :: (Chunk, Int)
formFieldState = (Chunk
initChunk, Int
initInt)
                    , formFields :: [FormField (Chunk, Int) (Chunk, Int) e Name]
formFields = [ 
                                     forall a b e n.
n
-> (b -> Maybe a)
-> Bool
-> (Bool -> b -> Widget n)
-> (BrickEvent n e -> EventM n b ())
-> FormField a b e n
FormField Name
ChunkField1 forall {b}. (Chunk, b) -> Maybe (Chunk, b)
validateChunk Bool
True
                                       Bool -> (Chunk, Int) -> Widget Name
renderChunk1
                                       forall n e. BrickEvent n e -> EventM n (Chunk, Int) ()
handleChunkEvent1,
                                     forall a b e n.
n
-> (b -> Maybe a)
-> Bool
-> (Bool -> b -> Widget n)
-> (BrickEvent n e -> EventM n b ())
-> FormField a b e n
FormField Name
ChunkField2 forall {b}. (Chunk, b) -> Maybe (Chunk, b)
validateChunk Bool
True
                                       Bool -> (Chunk, Int) -> Widget Name
renderChunk2
                                       forall n e. BrickEvent n e -> EventM n (Chunk, Int) ()
handleChunkEvent2,
                                     forall a b e n.
n
-> (b -> Maybe a)
-> Bool
-> (Bool -> b -> Widget n)
-> (BrickEvent n e -> EventM n b ())
-> FormField a b e n
FormField Name
SubsetField forall a. a -> Maybe a
validateSubset Bool
True
                                       Bool -> (Chunk, Int) -> Widget Name
renderSubset
                                       forall n e. BrickEvent n e -> EventM n (Chunk, Int) ()
handleSubsetEvent
                                   ]
                    , formFieldLens :: Lens' s (Chunk, Int)
formFieldLens = Lens' s (Chunk, Int)
stLens
                    , formFieldUpdate :: (Chunk, Int) -> (Chunk, Int) -> (Chunk, Int)
formFieldUpdate = forall a b. a -> b -> a
const
                    , formFieldRenderHelper :: Widget Name -> Widget Name
formFieldRenderHelper = forall a. a -> a
id
                    , formFieldConcat :: [Widget Name] -> Widget Name
formFieldConcat = [Widget Name] -> Widget Name
customConcat
                    , formFieldVisibilityMode :: FormFieldVisibilityMode
formFieldVisibilityMode = FormFieldVisibilityMode
ShowAugmentedField }

okField :: (Ord n, Show n) => Lens' s Bool -> n -> String -> s -> FormFieldState s e n
okField :: forall n s e.
(Ord n, Show n) =>
Lens' s Bool -> n -> String -> s -> FormFieldState s e n
okField Lens' s Bool
stLens n
name String
label s
initialState =
  let initVal :: Bool
initVal = s
initialState forall s a. s -> Getting a s a -> a
^. Lens' s Bool
stLens

      handleEvent :: BrickEvent n e -> m ()
handleEvent (VtyEvent (V.EvKey Key
V.KEnter [])) = forall s (m :: * -> *). MonadState s m => s -> m ()
put Bool
True
      handleEvent BrickEvent n e
_ = forall (m :: * -> *) a. Monad m => a -> m a
return ()
  
  in FormFieldState { formFieldState :: Bool
formFieldState = Bool
initVal
                    , formFields :: [FormField Bool Bool e n]
formFields = [ forall a b e n.
n
-> (b -> Maybe a)
-> Bool
-> (Bool -> b -> Widget n)
-> (BrickEvent n e -> EventM n b ())
-> FormField a b e n
FormField n
name forall a. a -> Maybe a
Just Bool
True 
                                       (forall n. String -> n -> Bool -> Bool -> Widget n
renderOk String
label n
name)
                                       forall {m :: * -> *} {n} {e}.
MonadState Bool m =>
BrickEvent n e -> m ()
handleEvent ]
                    , formFieldLens :: Lens' s Bool
formFieldLens = Lens' s Bool
stLens
                    , formFieldUpdate :: Bool -> Bool -> Bool
formFieldUpdate = forall a b. a -> b -> a
const
                    , formFieldRenderHelper :: Widget n -> Widget n
formFieldRenderHelper = forall a. a -> a
id
                    , formFieldConcat :: [Widget n] -> Widget n
formFieldConcat = forall n. [Widget n] -> Widget n
vBox
                    , formFieldVisibilityMode :: FormFieldVisibilityMode
formFieldVisibilityMode = FormFieldVisibilityMode
ShowAugmentedField }

renderOk :: String -> n -> Bool -> Bool -> Widget n
renderOk :: forall n. String -> n -> Bool -> Bool -> Widget n
renderOk String
label n
_ Bool
focus Bool
_ =
  (if Bool
focus then forall n. AttrName -> Widget n -> Widget n
withAttr AttrName
selectedAttr else forall a. a -> a
id) forall a b. (a -> b) -> a -> b
$ forall n. String -> Widget n
str String
"Ok"