{-# LANGUAGE FlexibleContexts #-}
{-# OPTIONS_HADDOCK show-extensions #-}

-- |
-- Module      :  Yi.UI.Utils
-- License     :  GPL-2
-- Maintainer  :  yi-devel@googlegroups.com
-- Stability   :  experimental
-- Portability :  portable
--
-- Utilities shared by various UIs

module Yi.UI.Utils where

import           Prelude                   hiding (mapM)

import           Control.Arrow             (second)
import           Lens.Micro.Platform                (use)
import           Control.Monad.State       (evalState, modify)
import           Control.Monad.State.Class (gets)
import           Data.Foldable             (maximumBy)
import           Data.Function             (on)
import           Data.List                 (transpose)
import           Data.List.Split           (chunksOf)
import           Data.Monoid               (Endo (appEndo))
import qualified Data.Text                 as T (Text, null, pack, unpack)
import           Data.Traversable          (mapM)
import           Yi.Buffer
import           Yi.String                 (padLeft)
import           Yi.Style                  (Attributes, StyleName, UIStyle (baseAttributes, selectedStyle))
import           Yi.Syntax                 (Span (..))
import           Yi.Window                 (Window (height, isMini))

applyHeights :: Traversable t => [Int] -> t Window -> t Window
applyHeights :: [Int] -> t Window -> t Window
applyHeights [Int]
heights t Window
ws = State [Int] (t Window) -> [Int] -> t Window
forall s a. State s a -> s -> a
evalState ((Window -> StateT [Int] Identity Window)
-> t Window -> State [Int] (t Window)
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Window -> StateT [Int] Identity Window
forall (m :: * -> *). MonadState [Int] m => Window -> m Window
distribute t Window
ws) [Int]
heights
    where
      distribute :: Window -> m Window
distribute Window
win = if Window -> Bool
isMini Window
win
          then Window -> m Window
forall (m :: * -> *) a. Monad m => a -> m a
return Window
win{height :: Int
height = Int
1}
          else (do Int
h <- ([Int] -> Int) -> m Int
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets [Int] -> Int
forall a. [a] -> a
head
                   ([Int] -> [Int]) -> m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify [Int] -> [Int]
forall a. [a] -> [a]
tail
                   Window -> m Window
forall (m :: * -> *) a. Monad m => a -> m a
return Window
win{height :: Int
height = Int
h})

spliceAnnots :: [(Point,Char)] -> [Span String] -> [(Point,Char)]
spliceAnnots :: [(Point, Char)] -> [Span String] -> [(Point, Char)]
spliceAnnots [(Point, Char)]
text [] = [(Point, Char)]
text
spliceAnnots [(Point, Char)]
text (Span Point
start String
x Point
stop:[Span String]
anns) = [(Point, Char)]
l [(Point, Char)] -> [(Point, Char)] -> [(Point, Char)]
forall a. [a] -> [a] -> [a]
++ [Point] -> String -> [(Point, Char)]
forall a b. [a] -> [b] -> [(a, b)]
zip (Point -> [Point]
forall a. a -> [a]
repeat Point
start) String
x [(Point, Char)] -> [(Point, Char)] -> [(Point, Char)]
forall a. [a] -> [a] -> [a]
++ [(Point, Char)] -> [Span String] -> [(Point, Char)]
spliceAnnots [(Point, Char)]
r [Span String]
anns
    where ([(Point, Char)]
l,[(Point, Char)]
rest) =  ((Point, Char) -> Bool)
-> [(Point, Char)] -> ([(Point, Char)], [(Point, Char)])
forall a. (a -> Bool) -> [a] -> ([a], [a])
span ((Point
start Point -> Point -> Bool
forall a. Ord a => a -> a -> Bool
>) (Point -> Bool)
-> ((Point, Char) -> Point) -> (Point, Char) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Point, Char) -> Point
forall a b. (a, b) -> a
fst) [(Point, Char)]
text
          ([(Point, Char)]
_,[(Point, Char)]
r) = ((Point, Char) -> Bool)
-> [(Point, Char)] -> ([(Point, Char)], [(Point, Char)])
forall a. (a -> Bool) -> [a] -> ([a], [a])
span ((Point
stop Point -> Point -> Bool
forall a. Ord a => a -> a -> Bool
>) (Point -> Bool)
-> ((Point, Char) -> Point) -> (Point, Char) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Point, Char) -> Point
forall a b. (a, b) -> a
fst) [(Point, Char)]
rest

-- | Turn a sequence of (from,style,to) strokes into a sequence
--   of picture points (from,style), taking special care to
--   ensure that the points are strictly increasing and introducing
--   padding segments where neccessary.
--   Precondition: Strokes are ordered and not overlapping.
strokePicture :: [Span (Endo a)] -> [(Point,a -> a)]
strokePicture :: [Span (Endo a)] -> [(Point, a -> a)]
strokePicture [] = []
strokePicture wholeList :: [Span (Endo a)]
wholeList@(Span Point
leftMost Endo a
_ Point
_:[Span (Endo a)]
_) = Point -> [Span (Endo a)] -> [(Point, a -> a)]
forall a. Point -> [Span (Endo a)] -> [(Point, a -> a)]
helper Point
leftMost [Span (Endo a)]
wholeList
    where helper :: Point -> [Span (Endo a)] -> [(Point,a -> a)]
          helper :: Point -> [Span (Endo a)] -> [(Point, a -> a)]
helper Point
prev [] = [(Point
prev,a -> a
forall a. a -> a
id)]
          helper Point
prev (Span Point
l Endo a
f Point
r:[Span (Endo a)]
xs)
              | Point
prev Point -> Point -> Bool
forall a. Ord a => a -> a -> Bool
< Point
l  = (Point
prev, a -> a
forall a. a -> a
id) (Point, a -> a) -> [(Point, a -> a)] -> [(Point, a -> a)]
forall a. a -> [a] -> [a]
: (Point
l,Endo a -> a -> a
forall a. Endo a -> a -> a
appEndo Endo a
f) (Point, a -> a) -> [(Point, a -> a)] -> [(Point, a -> a)]
forall a. a -> [a] -> [a]
: Point -> [Span (Endo a)] -> [(Point, a -> a)]
forall a. Point -> [Span (Endo a)] -> [(Point, a -> a)]
helper Point
r [Span (Endo a)]
xs
              | Bool
otherwise = (Point
l,Endo a -> a -> a
forall a. Endo a -> a -> a
appEndo Endo a
f) (Point, a -> a) -> [(Point, a -> a)] -> [(Point, a -> a)]
forall a. a -> [a] -> [a]
: Point -> [Span (Endo a)] -> [(Point, a -> a)]
forall a. Point -> [Span (Endo a)] -> [(Point, a -> a)]
helper Point
r [Span (Endo a)]
xs

-- | Paint the given stroke-picture on top of an existing picture
paintStrokes :: (a -> a) -> a -> [(Point,a -> a)] -> [(Point,a)] -> [(Point,a)]
paintStrokes :: (a -> a) -> a -> [(Point, a -> a)] -> [(Point, a)] -> [(Point, a)]
paintStrokes a -> a
f0 a
_  [] [(Point, a)]
lx = ((Point, a) -> (Point, a)) -> [(Point, a)] -> [(Point, a)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((a -> a) -> (Point, a) -> (Point, a)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second a -> a
f0)     [(Point, a)]
lx
paintStrokes a -> a
_  a
x0 [(Point, a -> a)]
lf [] = ((Point, a -> a) -> (Point, a))
-> [(Point, a -> a)] -> [(Point, a)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (((a -> a) -> a) -> (Point, a -> a) -> (Point, a)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second ((a -> a) -> a -> a
forall a b. (a -> b) -> a -> b
$ a
x0)) [(Point, a -> a)]
lf
paintStrokes a -> a
f0 a
x0 lf :: [(Point, a -> a)]
lf@((Point
pf,a -> a
f):[(Point, a -> a)]
tf) lx :: [(Point, a)]
lx@((Point
px,a
x):[(Point, a)]
tx) =
  case Point
pf Point -> Point -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` Point
px of
    Ordering
LT -> (Point
pf, a -> a
f  a
x0)(Point, a) -> [(Point, a)] -> [(Point, a)]
forall a. a -> [a] -> [a]
:(a -> a) -> a -> [(Point, a -> a)] -> [(Point, a)] -> [(Point, a)]
forall a.
(a -> a) -> a -> [(Point, a -> a)] -> [(Point, a)] -> [(Point, a)]
paintStrokes a -> a
f  a
x0 [(Point, a -> a)]
tf [(Point, a)]
lx
    Ordering
EQ -> (Point
pf, a -> a
f  a
x )(Point, a) -> [(Point, a)] -> [(Point, a)]
forall a. a -> [a] -> [a]
:(a -> a) -> a -> [(Point, a -> a)] -> [(Point, a)] -> [(Point, a)]
forall a.
(a -> a) -> a -> [(Point, a -> a)] -> [(Point, a)] -> [(Point, a)]
paintStrokes a -> a
f  a
x  [(Point, a -> a)]
tf [(Point, a)]
tx
    Ordering
GT -> (Point
px, a -> a
f0 a
x )(Point, a) -> [(Point, a)] -> [(Point, a)]
forall a. a -> [a] -> [a]
:(a -> a) -> a -> [(Point, a -> a)] -> [(Point, a)] -> [(Point, a)]
forall a.
(a -> a) -> a -> [(Point, a -> a)] -> [(Point, a)] -> [(Point, a)]
paintStrokes a -> a
f0 a
x  [(Point, a -> a)]
lf [(Point, a)]
tx



paintPicture :: a -> [[Span (Endo a)]] -> [(Point,a)]
paintPicture :: a -> [[Span (Endo a)]] -> [(Point, a)]
paintPicture a
a = ([Span (Endo a)] -> [(Point, a)] -> [(Point, a)])
-> [(Point, a)] -> [[Span (Endo a)]] -> [(Point, a)]
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr ((a -> a) -> a -> [(Point, a -> a)] -> [(Point, a)] -> [(Point, a)]
forall a.
(a -> a) -> a -> [(Point, a -> a)] -> [(Point, a)] -> [(Point, a)]
paintStrokes a -> a
forall a. a -> a
id a
a ([(Point, a -> a)] -> [(Point, a)] -> [(Point, a)])
-> ([Span (Endo a)] -> [(Point, a -> a)])
-> [Span (Endo a)]
-> [(Point, a)]
-> [(Point, a)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Span (Endo a)] -> [(Point, a -> a)]
forall a. [Span (Endo a)] -> [(Point, a -> a)]
strokePicture) []

attributesPictureB :: UIStyle -> Maybe SearchExp -> Region -> [[Span StyleName]]
    -> BufferM [(Point,Attributes)]
attributesPictureB :: UIStyle
-> Maybe SearchExp
-> Region
-> [[Span StyleName]]
-> BufferM [(Point, Attributes)]
attributesPictureB UIStyle
sty Maybe SearchExp
mexp Region
region [[Span StyleName]]
extraLayers =
  Attributes -> [[Span (Endo Attributes)]] -> [(Point, Attributes)]
forall a. a -> [[Span (Endo a)]] -> [(Point, a)]
paintPicture (UIStyle -> Attributes
baseAttributes UIStyle
sty) ([[Span (Endo Attributes)]] -> [(Point, Attributes)])
-> ([[Span StyleName]] -> [[Span (Endo Attributes)]])
-> [[Span StyleName]]
-> [(Point, Attributes)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
    ([Span StyleName] -> [Span (Endo Attributes)])
-> [[Span StyleName]] -> [[Span (Endo Attributes)]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Span StyleName -> Span (Endo Attributes))
-> [Span StyleName] -> [Span (Endo Attributes)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((StyleName -> Endo Attributes)
-> Span StyleName -> Span (Endo Attributes)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (StyleName -> StyleName
forall a b. (a -> b) -> a -> b
$ UIStyle
sty))) ([[Span StyleName]] -> [(Point, Attributes)])
-> ([[Span StyleName]] -> [[Span StyleName]])
-> [[Span StyleName]]
-> [(Point, Attributes)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
    ([[Span StyleName]]
extraLayers [[Span StyleName]] -> [[Span StyleName]] -> [[Span StyleName]]
forall a. [a] -> [a] -> [a]
++) ([[Span StyleName]] -> [(Point, Attributes)])
-> BufferM [[Span StyleName]] -> BufferM [(Point, Attributes)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
    Maybe SearchExp -> Region -> BufferM [[Span StyleName]]
strokesRangesB Maybe SearchExp
mexp Region
region

attributesPictureAndSelB :: UIStyle -> Maybe SearchExp -> Region -> BufferM [(Point,Attributes)]
attributesPictureAndSelB :: UIStyle
-> Maybe SearchExp -> Region -> BufferM [(Point, Attributes)]
attributesPictureAndSelB UIStyle
sty Maybe SearchExp
mexp Region
region = do
    Region
selReg <- BufferM Region
getSelectRegionB
    Bool
showSel <- Getting Bool FBuffer Bool -> BufferM Bool
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting Bool FBuffer Bool
Lens' FBuffer Bool
highlightSelectionA
    Bool
rectSel <- Getting Bool FBuffer Bool -> BufferM Bool
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting Bool FBuffer Bool
Lens' FBuffer Bool
rectangleSelectionA
    let styliseReg :: Region -> Span StyleName
styliseReg Region
reg = Point -> StyleName -> Point -> Span StyleName
forall a. Point -> a -> Point -> Span a
Span (Region -> Point
regionStart Region
reg) StyleName
selectedStyle (Region -> Point
regionEnd Region
reg)
        extraLayers :: BufferM [[Span StyleName]]
extraLayers | Bool
rectSel Bool -> Bool -> Bool
&& Bool
showSel = ([Span StyleName] -> [[Span StyleName]] -> [[Span StyleName]]
forall a. a -> [a] -> [a]
:[]) ([Span StyleName] -> [[Span StyleName]])
-> ([Region] -> [Span StyleName]) -> [Region] -> [[Span StyleName]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Region -> Span StyleName) -> [Region] -> [Span StyleName]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Region -> Span StyleName
styliseReg ([Region] -> [[Span StyleName]])
-> BufferM [Region] -> BufferM [[Span StyleName]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Region -> BufferM [Region]
blockifyRegion Region
selReg
                    | Bool
showSel            = [[Span StyleName]] -> BufferM [[Span StyleName]]
forall (m :: * -> *) a. Monad m => a -> m a
return [[Region -> Span StyleName
styliseReg Region
selReg]]
                    | Bool
otherwise          = [[Span StyleName]] -> BufferM [[Span StyleName]]
forall (m :: * -> *) a. Monad m => a -> m a
return []
    UIStyle
-> Maybe SearchExp
-> Region
-> [[Span StyleName]]
-> BufferM [(Point, Attributes)]
attributesPictureB UIStyle
sty Maybe SearchExp
mexp Region
region ([[Span StyleName]] -> BufferM [(Point, Attributes)])
-> BufferM [[Span StyleName]] -> BufferM [(Point, Attributes)]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< BufferM [[Span StyleName]]
extraLayers


-- | Arrange a list of items in columns over maximum @maxNumberOfLines@ lines
arrangeItems :: [T.Text] -> Int -> Int -> [T.Text]
arrangeItems :: [Text] -> Int -> Int -> [Text]
arrangeItems [Text]
items Int
_ Int
_ | (Text -> Bool) -> [Text] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Text -> Bool
T.null [Text]
items = []
arrangeItems [Text]
items Int
maxWidth Int
maxNumberOfLines = Int -> [Text] -> [Text]
forall a. Int -> [a] -> [a]
take Int
maxNumberOfLines ([Text] -> [Text]) -> [Text] -> [Text]
forall a b. (a -> b) -> a -> b
$ (Int, [Text]) -> [Text]
forall a b. (a, b) -> b
snd (Int, [Text])
choice
    where choice :: (Int, [Text])
choice = ((Int, [Text]) -> (Int, [Text]) -> Ordering)
-> [(Int, [Text])] -> (Int, [Text])
forall (t :: * -> *) a.
Foldable t =>
(a -> a -> Ordering) -> t a -> a
maximumBy (Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Int -> Int -> Ordering)
-> ((Int, [Text]) -> Int)
-> (Int, [Text])
-> (Int, [Text])
-> Ordering
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` (Int, [Text]) -> Int
forall a b. (a, b) -> a
fst) [(Int, [Text])]
arrangements
          arrangements :: [(Int, [Text])]
arrangements = (Int -> (Int, [Text])) -> [Int] -> [(Int, [Text])]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ([Text] -> Int -> Int -> (Int, [Text])
arrangeItems' [Text]
items Int
maxWidth) ([Int] -> [Int]
forall a. [a] -> [a]
reverse [Int
1..Int
maxNumberOfLines])

-- | Arrange a list of items in columns over @numberOfLines@ lines.
--
-- TODO: proper Text/YiString implementation
arrangeItems' :: [T.Text] -> Int -> Int -> (Int, [T.Text])
arrangeItems' :: [Text] -> Int -> Int -> (Int, [Text])
arrangeItems' [Text]
items' Int
maxWidth Int
numberOfLines = (Int
fittedItems,[Text]
theLines)
    where items :: [String]
items = Text -> String
T.unpack (Text -> String) -> [Text] -> [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Text]
items'
          columns :: [[String]]
columns = Int -> [String] -> [[String]]
forall e. Int -> [e] -> [[e]]
chunksOf Int
numberOfLines [String]
items
          columnsWidth :: [Int]
columnsWidth = ([String] -> Int) -> [[String]] -> [Int]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ([Int] -> Int
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum ([Int] -> Int) -> ([String] -> [Int]) -> [String] -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> Int) -> [String] -> [Int]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length) [[String]]
columns
          totalWidths :: [Int]
totalWidths = (Int -> Int -> Int) -> Int -> [Int] -> [Int]
forall b a. (b -> a -> b) -> b -> [a] -> [b]
scanl (\Int
x Int
y -> Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
x Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
y) Int
0 [Int]
columnsWidth
          shownItems :: [Int]
shownItems = (Int -> Int -> Int) -> Int -> [Int] -> [Int]
forall b a. (b -> a -> b) -> b -> [a] -> [b]
scanl Int -> Int -> Int
forall a. Num a => a -> a -> a
(+) Int
0 (([String] -> Int) -> [[String]] -> [Int]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [String] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [[String]]
columns)
          fittedItems :: Int
fittedItems = (Int, Int) -> Int
forall a b. (a, b) -> b
snd ((Int, Int) -> Int) -> (Int, Int) -> Int
forall a b. (a -> b) -> a -> b
$ [(Int, Int)] -> (Int, Int)
forall a. [a] -> a
last ([(Int, Int)] -> (Int, Int)) -> [(Int, Int)] -> (Int, Int)
forall a b. (a -> b) -> a -> b
$ ((Int, Int) -> Bool) -> [(Int, Int)] -> [(Int, Int)]
forall a. (a -> Bool) -> [a] -> [a]
takeWhile ((Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
maxWidth) (Int -> Bool) -> ((Int, Int) -> Int) -> (Int, Int) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int, Int) -> Int
forall a b. (a, b) -> a
fst) ([(Int, Int)] -> [(Int, Int)]) -> [(Int, Int)] -> [(Int, Int)]
forall a b. (a -> b) -> a -> b
$ [Int] -> [Int] -> [(Int, Int)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int]
totalWidths [Int]
shownItems
          theLines :: [Text]
theLines = String -> Text
T.pack (String -> Text) -> ([String] -> String) -> [String] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> String
unwords ([String] -> String)
-> ([String] -> [String]) -> [String] -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> String -> String) -> [Int] -> [String] -> [String]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Int -> String -> String
padLeft [Int]
columnsWidth ([String] -> Text) -> [[String]] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [[String]] -> [[String]]
forall a. [[a]] -> [[a]]
transpose [[String]]
columns