{-# OPTIONS_HADDOCK show-extensions #-}

-- |
-- Module      :  Yi.UI.TabBar
-- License     :  GPL-2
-- Maintainer  :  yi-devel@googlegroups.com
-- Stability   :  experimental
-- Portability :  portable
--
-- Tabs.

module Yi.UI.TabBar where

import           Lens.Micro.Platform                     ((^.))
import qualified Data.List.PointedList.Circular as PL (PointedList (_focus), withFocus)
import qualified Data.Text                      as T (Text, pack, unpack)
import           System.FilePath                (isValid, splitPath)
import           Yi.Buffer                      (shortIdentString)
import           Yi.Editor                      (Editor (..), commonNamePrefix, findBufferWith, tabsA)
import           Yi.Tab                         (tabWindowsA)
import           Yi.Window                      (Window (bufkey))

-- | A TabDescr describes the properties of a UI tab independent of
-- the particular GUI in use.
data TabDescr = TabDescr
    { TabDescr -> Text
tabText :: T.Text
    , TabDescr -> Bool
tabInFocus :: Bool
    } deriving (Int -> TabDescr -> ShowS
[TabDescr] -> ShowS
TabDescr -> String
(Int -> TabDescr -> ShowS)
-> (TabDescr -> String) -> ([TabDescr] -> ShowS) -> Show TabDescr
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TabDescr] -> ShowS
$cshowList :: [TabDescr] -> ShowS
show :: TabDescr -> String
$cshow :: TabDescr -> String
showsPrec :: Int -> TabDescr -> ShowS
$cshowsPrec :: Int -> TabDescr -> ShowS
Show, TabDescr -> TabDescr -> Bool
(TabDescr -> TabDescr -> Bool)
-> (TabDescr -> TabDescr -> Bool) -> Eq TabDescr
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TabDescr -> TabDescr -> Bool
$c/= :: TabDescr -> TabDescr -> Bool
== :: TabDescr -> TabDescr -> Bool
$c== :: TabDescr -> TabDescr -> Bool
Eq)

type TabBarDescr = PL.PointedList TabDescr

tabBarDescr :: Editor -> TabBarDescr
tabBarDescr :: Editor -> TabBarDescr
tabBarDescr Editor
editor = (Tab, Bool) -> TabDescr
tabDescr ((Tab, Bool) -> TabDescr) -> PointedList (Tab, Bool) -> TabBarDescr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> PointedList Tab -> PointedList (Tab, Bool)
forall a. PointedList a -> PointedList (a, Bool)
PL.withFocus (Editor
editor Editor
-> Getting (PointedList Tab) Editor (PointedList Tab)
-> PointedList Tab
forall s a. s -> Getting a s a -> a
^. Getting (PointedList Tab) Editor (PointedList Tab)
Lens' Editor (PointedList Tab)
tabsA)
  where
    prefix :: [String]
prefix = Editor -> [String]
commonNamePrefix Editor
editor
    shorten :: FBuffer -> Text
shorten = Text -> Text
tabAbbrevTitle (Text -> Text) -> (FBuffer -> Text) -> FBuffer -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> FBuffer -> Text
shortIdentString ([String] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [String]
prefix)
    mkHintWith :: BufferRef -> Text
mkHintWith BufferRef
f = FBuffer -> Text
shorten (FBuffer -> Text) -> FBuffer -> Text
forall a b. (a -> b) -> a -> b
$ BufferRef -> Editor -> FBuffer
findBufferWith BufferRef
f Editor
editor
    hintForTab :: Tab -> Text
hintForTab Tab
tab = BufferRef -> Text
mkHintWith (Window -> BufferRef
bufkey (Window -> BufferRef) -> Window -> BufferRef
forall a b. (a -> b) -> a -> b
$ PointedList Window -> Window
forall a. PointedList a -> a
PL._focus (Tab
tab Tab
-> Getting (PointedList Window) Tab (PointedList Window)
-> PointedList Window
forall s a. s -> Getting a s a -> a
^. Getting (PointedList Window) Tab (PointedList Window)
forall (f :: * -> *).
Functor f =>
(PointedList Window -> f (PointedList Window)) -> Tab -> f Tab
tabWindowsA))

    tabDescr :: (Tab, Bool) -> TabDescr
tabDescr (Tab
tab, Bool
True)  = Text -> Bool -> TabDescr
TabDescr (Tab -> Text
hintForTab Tab
tab) Bool
True
    tabDescr (Tab
tab, Bool
False) = Text -> Bool -> TabDescr
TabDescr (Tab -> Text
hintForTab Tab
tab) Bool
False


-- FIXME: it seems that using splitDirectories can abstract the '/'
-- handling away. (Making it win32 friendly and simpler)
tabAbbrevTitle :: T.Text -> T.Text
tabAbbrevTitle :: Text -> Text
tabAbbrevTitle Text
title = if String -> Bool
isValid String
fp
                       then String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ ShowS -> [String] -> String
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ShowS
abbrev (String -> [String]
splitPath String
fp)
                       else Text
title
  where
    fp :: String
fp = Text -> String
T.unpack Text
title
    abbrev :: ShowS
abbrev String
"/" = String
"/"
    abbrev String
path | String -> Char
forall a. [a] -> a
head String
path Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'.' Bool -> Bool -> Bool
&& String -> Char
forall a. [a] -> a
last String
path Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'/' = Int -> ShowS
forall a. Int -> [a] -> [a]
take Int
2 String
path String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"/"
                | String -> Char
forall a. [a] -> a
last String
path Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'/' = String -> Char
forall a. [a] -> a
head String
path Char -> ShowS
forall a. a -> [a] -> [a]
: String
"/"
                | Bool
otherwise        = String
path