Folder.hs

{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE NamedFieldPuns #-}

module Pages.Folder (fileBrowser) where

import Reflex.Material.List
import Reflex.Material.Types

import Data.List.Extra
import Data.Text
import Reflex.Dom.Core

import Obelisk.Route.Frontend
import Common.Route
import MagicFolder

iconForEntry :: FolderEntry -> Text
iconForEntry File { } = "insert_drive_file"
iconForEntry Directory { } = "folder_open"

describeEntry :: FolderEntry -> Text
describeEntry File { folderEntrySize } = humanReadableSize folderEntrySize
describeEntry Directory { folderEntrySize, directoryChildCount } =
    Data.Text.concat [ childCount, "; ", humanReadableSize folderEntrySize, "; "]
        where
          childCount = case directoryChildCount of
                         1 -> "1 file"
                         n -> (Data.Text.pack . show $ n) <> " files"

humanReadableSize :: Integer -> Text
humanReadableSize n
    | n < 1000 = fmt 1000 "B"
    | n < 1000000 = fmt 1000000 "KB"
    | n < 1000000000 = fmt 1000000000 "MB"
    | n < 1000000000000 = fmt 1000000000000 "GB"
    | otherwise = fmt 1000000000000000 "TB"
    where
      fmt :: Integer -> Text -> Text
      fmt m suffix = (Data.Text.pack . show . (`div` m) $ n) <> " " <> suffix

data LeaveAction
    -- | Close the file browser.
    = Close
    -- | Navigate up one level in the directory hierarchy.
    | Up
      deriving (Eq, Ord, Show)

-- | For a given file browser path, determine what the "leave this page"
-- action means.
leaveAction :: [Text] -> LeaveAction
leaveAction [] = Close
leaveAction (_:[]) = Close
leaveAction _ = Up

leaveActionIcon :: LeaveAction -> Text
leaveActionIcon Close = "close"
leaveActionIcon Up = "arrow_back"

-- | Define the entire view for looking at a single folder and its direct
-- contents.
fileBrowser :: ( DomBuilder t m
               , PostBuild t m
               , SetRoute t (R FrontendRoute) m
               , Routed t [Text] m
               ) => Dynamic t [FolderEntry] -> m ()
fileBrowser entriesDyn = do
      r <- askRoute
      elClass "header" "mdc-top-app-bar mdc-ripple-surface" $
        divClass "mdc-top-app-bar__row" $
          elClass "section" "mdc-top-app-bar__section mdc-top-app-bar__section--align-start" $ do
            (leaveButton, _) <- elAttr' "button" ("class" =: "material-icons mdc-top-app-bar__navigation-icon mdc-icon-button" <> "aria-label" =: "Close") $
              dynText $ leaveActionIcon . leaveAction <$> r
            elClass "span" "mdc-top-app-bar__title" $
              text "Documents"
            elAttr "section" ("class" =: "mdc-top-app-bar__section mdc-top-app-bar__section--align-end" <> "role" =: "toolbar") $ do
              elAttr "button" ("class" =: "material-icons mdc-top-app-bar__action-item mdc-icon-button" <> "aria-label" =: "Share") $
                text "share"
              elAttr "button" ("class" =: "material-icons mdc-top-app-bar__action-item mdc-icon-button" <> "aria-label" =: "Delete") $
                text "delete"
              elAttr "button" ("Class" =: "material-icons mdc-top-app-bar__action-item mdc-icon-button" <> "aria-label" =: "Open menu") $
                text "more_vert"

            setRoute $ ffor (tag (current r) (domEvent Click leaveButton)) $ \path ->
                case leaveAction path of
                  Close -> FrontendRoute_MagicFolders :/ ()
                  Up -> FrontendRoute_FileBrowser :/ (dropEnd1 path)

      elClass "main" "mdc-top-app-bar--fixed-adjust" $ do

        list_ "ul" (mdcListTwoLine_ <> CssClass "mdc-list" <> CssClass "inline-demo-list") $
            dyn_ $ mapM_ fileBrowserEntryWidget <$> entriesDyn

        el "script" $
          text "mdc.ripple.MDCRipple.attachTo(document.querySelector('.mdc-ripple-surface'));"

-- | Define the view for a single item in a file browser, including an icon,
-- the item name, and some metadata.
fileBrowserEntryWidget :: (DomBuilder t m, SetRoute t (R FrontendRoute) m, Routed t [Text] m) => FolderEntry -> m ()
fileBrowserEntryWidget entry = do
    (theEl, _) <- elClass' "li" "mdc-list-item mdc-ripple-surface" $ do
      elAttr "span" ("class" =: "mdc-list-item__graphic material-icons" <> "aria-hidden" =: "true") $
        text $ iconForEntry entry
      elAttr "span" ("class" =: "mdc-list-item__text") $ do
        elAttr "span" ("class" =: "mdc-list-item__primary-text") $
          text $ folderEntryName entry
        elAttr "span" ("class" =: "mdc-list-item__secondary-text") $
          text $ describeEntry entry

    case entry of
      Directory { } -> do
                 r <- askRoute
                 setRoute $
                       (FrontendRoute_FileBrowser :/) . (flip Data.List.Extra.snoc (folderEntryName entry)) <$>
                       tag (current r) (domEvent Click theEl)
      _ -> pure ()