itemfield-1.2.0.0: examples/bookcase.hs

{-# 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.Default
import Data.String (IsString)
import qualified Data.Text as T
import Brick
import Brick.Widgets.Border
import Graphics.Vty (Event(..), Key(..))
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 = return $ 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 def
                    , appChooseCursor = showFirstCursor
                    }