module Taskell.UI.Draw.Modal.MoveTo
    ( moveTo
    ) where

import ClassyPrelude

import Control.Lens ((^.))

import Brick

import Taskell.Data.List          (title)
import Taskell.Events.State.Types (current, lists)
import Taskell.Types              (showListIndex)
import Taskell.UI.Draw.Field      (textField)
import Taskell.UI.Draw.Types      (DrawState (dsState), ModalWidget)
import Taskell.UI.Theme           (taskCurrentAttr)

moveTo :: ModalWidget
moveTo :: ModalWidget
moveTo = do
    Int
skip <- ListIndex -> Int
showListIndex (ListIndex -> Int) -> (State -> ListIndex) -> State -> Int
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (ListIndex, TaskIndex) -> ListIndex
forall a b. (a, b) -> a
fst ((ListIndex, TaskIndex) -> ListIndex)
-> (State -> (ListIndex, TaskIndex)) -> State -> ListIndex
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (State
-> Getting (ListIndex, TaskIndex) State (ListIndex, TaskIndex)
-> (ListIndex, TaskIndex)
forall s a. s -> Getting a s a -> a
^. Getting (ListIndex, TaskIndex) State (ListIndex, TaskIndex)
Lens' State (ListIndex, TaskIndex)
current) (State -> Int)
-> ReaderT DrawState Identity State
-> ReaderT DrawState Identity Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (DrawState -> State) -> ReaderT DrawState Identity State
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks DrawState -> State
dsState
    [List]
ls <- Lists -> [List]
forall mono. MonoFoldable mono => mono -> [Element mono]
toList (Lists -> [List]) -> (State -> Lists) -> State -> [List]
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (State -> Getting Lists State Lists -> Lists
forall s a. s -> Getting a s a -> a
^. Getting Lists State Lists
Lens' State Lists
lists) (State -> [List])
-> ReaderT DrawState Identity State
-> ReaderT DrawState Identity [List]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (DrawState -> State) -> ReaderT DrawState Identity State
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks DrawState -> State
dsState
    let titles :: [Widget ResourceName]
titles = Text -> Widget ResourceName
textField (Text -> Widget ResourceName)
-> (List -> Text) -> List -> Widget ResourceName
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (List -> Getting Text List Text -> Text
forall s a. s -> Getting a s a -> a
^. Getting Text List Text
Lens' List Text
title) (List -> Widget ResourceName) -> [List] -> [Widget ResourceName]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [List]
ls
    let letter :: Char -> Widget n
letter Char
a =
            Padding -> Widget n -> Widget n
forall n. Padding -> Widget n -> Widget n
padRight (Int -> Padding
Pad Int
1) (Widget n -> Widget n)
-> ([Widget n] -> Widget n) -> [Widget n] -> Widget n
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. [Widget n] -> Widget n
forall n. [Widget n] -> Widget n
hBox ([Widget n] -> Widget n) -> [Widget n] -> Widget n
forall a b. (a -> b) -> a -> b
$
            [Text -> Widget n
forall n. Text -> Widget n
txt Text
"[", AttrName -> Widget n -> Widget n
forall n. AttrName -> Widget n -> Widget n
withAttr AttrName
taskCurrentAttr (Widget n -> Widget n) -> Widget n -> Widget n
forall a b. (a -> b) -> a -> b
$ Text -> Widget n
forall n. Text -> Widget n
txt (Element Text -> Text
forall seq. MonoPointed seq => Element seq -> seq
singleton Char
Element Text
a), Text -> Widget n
forall n. Text -> Widget n
txt Text
"]"]
    let letters :: [Widget n]
letters = Char -> Widget n
forall n. Char -> Widget n
letter (Char -> Widget n) -> [Char] -> [Widget n]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Char
'a' ..]
    let remove :: Index seq -> seq -> seq
remove Index seq
i seq
l = Index seq -> seq -> seq
forall seq. IsSequence seq => Index seq -> seq -> seq
take Index seq
i seq
l seq -> seq -> seq
forall a. Semigroup a => a -> a -> a
<> Index seq -> seq -> seq
forall seq. IsSequence seq => Index seq -> seq -> seq
drop (Index seq
i Index seq -> Index seq -> Index seq
forall a. Num a => a -> a -> a
+ Index seq
1) seq
l
    let output :: (Widget n, Widget n) -> Widget n
output (Widget n
l, Widget n
t) = Widget n
l Widget n -> Widget n -> Widget n
forall n. Widget n -> Widget n -> Widget n
<+> Widget n
t
    let widget :: Widget ResourceName
widget = [Widget ResourceName] -> Widget ResourceName
forall n. [Widget n] -> Widget n
vBox ([Widget ResourceName] -> Widget ResourceName)
-> [Widget ResourceName] -> Widget ResourceName
forall a b. (a -> b) -> a -> b
$ (Widget ResourceName, Widget ResourceName) -> Widget ResourceName
forall n. (Widget n, Widget n) -> Widget n
output ((Widget ResourceName, Widget ResourceName) -> Widget ResourceName)
-> [(Widget ResourceName, Widget ResourceName)]
-> [Widget ResourceName]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Index [(Widget ResourceName, Widget ResourceName)]
-> [(Widget ResourceName, Widget ResourceName)]
-> [(Widget ResourceName, Widget ResourceName)]
forall seq. IsSequence seq => Index seq -> seq -> seq
remove Int
Index [(Widget ResourceName, Widget ResourceName)]
skip ([Widget ResourceName]
-> [Widget ResourceName]
-> [(Widget ResourceName, Widget ResourceName)]
forall (f :: * -> *) a b. Zip f => f a -> f b -> f (a, b)
zip [Widget ResourceName]
forall n. [Widget n]
letters [Widget ResourceName]
titles)
    (Text, Widget ResourceName) -> ModalWidget
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text
"Move To:", Widget ResourceName
widget)