{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TemplateHaskell #-} {- This is an example of a bookcase with a number of shelves, each containing a number of books. The books can be "checked out" and the itemfield will change to indicate the missing status for that book. -} module Main where import Data.List (intercalate) import Data.Monoid import Data.String (IsString) import qualified Data.Text as T import Brick import Brick.Widgets.Border import Graphics.Vty (Event(..), Key(..)) import Graphics.Vty.Attributes (defAttr) import TextUI.ItemField import Lens.Micro ((^.)) import Lens.Micro.TH (makeLenses) data BookCaseState n = BookCaseState { _shelves :: ItemFieldWidget n , _books :: [T.Text] } makeLenses ''BookCaseState sampleBookCase :: ItemIdent -> ItemField sampleBookCase = newItemField [ ItemGroup "Top Shelf" (Items 5) , ItemGroup "Fiction" (Items 320) , ItemGroup "Fiction" (ItemGroup "SciFi" (Items 12)) , ItemGroup "Fiction" (ItemGroup "Romance" (Items 121)) , ItemGroup "Reference" (Items 113) , ItemGroup "Shelf 5" (Items 86) , ItemGroup "Childrens" (ItemGroup "Dr. Seuss" (Items 3)) , ItemGroup "Childrens" (ItemGroup "Primers" (Items 8)) , ItemGroup "Childrens" (ItemGroup "Pictures" (ItemGroup "Animals" (Items 5))) , ItemGroup "Childrens" (ItemGroup "Pictures" (ItemGroup "Thomas the Tank Engine" (Items 12))) , ItemGroup "Bottom Shelf" (Items 0) ] initialState :: n -> BookCaseState n initialState n = let blank = T.pack "" scifi = 5 + 320 scifi_books = ["Fahrenheit 451", "Snow Crash", "Idoru", "Starburst", "Cryptonomicon"] <> replicate (12 - 5) blank scifi_to_seuss = 121 + 113 + 86 seuss_books = ["One Fish, Two Fish", "Cat In The Hat", "The Lorax"] all_books = replicate scifi blank <> scifi_books <> replicate (scifi_to_seuss) blank <> seuss_books in BookCaseState (ItemFieldWidget n $ sampleBookCase $ Just $ showBookCaseItem all_books) all_books bookstate :: IsString s => ItemState -> s bookstate s = case s of Good -> "read by you" Bad -> "missing or damaged" Pending -> "on loan" _ -> "" showBookCaseItem :: [T.Text] -> Int -> ItemState -> T.Text showBookCaseItem booklist idx st8 = let book = booklist !! idx bookid = if idx >= length booklist then T.pack $ "Book #" <> show idx else if T.null book then T.pack $ "Untitled Book #" <> show idx else book bookinfo = case bookstate st8 of "" -> "" a -> " (" <> a <> ")" in bookid <> bookinfo data MainIFName = MainItemFieldName deriving (Eq, Ord, Show) showBookcase :: (Show n, Ord n) => BookCaseState n -> [Widget n] showBookcase bc = [ vBox [ borderWithLabel (str "BookCase Contents") $ itemFieldWidget $ bc^.shelves , str " Movement: arrows, or '<' and '>' to jump." , str "Toggle item selection: space = single item, L = line, G = group, A = all" , str " right or left arrow with shift extends selection" , str " !, ~, or + selects all corresponding items" , str " Misc: Q/q = quit, r = read book, l = loan book, m = missing book" ] ] bookEvent :: Ord n => BookCaseState n -> BrickEvent n e -> EventM n (Next (BookCaseState n)) bookEvent s (VtyEvent e) = bkVtyEvent e where bkVtyEvent (EvResize _ _) = continue s bkVtyEvent (EvKey (KChar 'r') []) = continue =<< handleEventLensed s shelves (setBooks Good) e bkVtyEvent (EvKey (KChar 'l') []) = continue =<< handleEventLensed s shelves (setBooks Pending) e bkVtyEvent (EvKey (KChar 'm') []) = continue =<< handleEventLensed s shelves (setBooks Bad) e bkVtyEvent (EvKey (KChar 'Q') []) = halt s bkVtyEvent (EvKey (KChar 'q') []) = halt s bkVtyEvent o = continue =<< handleEventLensed s shelves handleItemFieldEvent o bookEvent s _ = continue s -- =<< handleEventLensed s shelves handleItemFieldEvent o setBooks :: ItemState -> e -> ItemFieldWidget n -> EventM n (ItemFieldWidget n) setBooks toState _ fieldw = setMarkedItemsState toState fieldw main :: IO () main = do result <- defaultMain app (initialState MainItemFieldName) let finalBookcase = itemField $ result^.shelves st8s = itemst8 finalBookcase numSt8 st8 = length . filter ((==) st8) showNum = show . flip numSt8 st8s summary s = showNum s <> " " <> bookstate s putStrLn $ "Final bookcase state: " <> intercalate ", " [ (show $ length st8s) <> " books" , summary Good, summary Pending, summary Bad ] where app = App { appDraw = showBookcase , appHandleEvent = bookEvent , appStartEvent = return , appAttrMap = const $ applyAttrMappings itemDefaultAttrs $ attrMap defAttr [] , appChooseCursor = showFirstCursor }