{-# 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"