{-# 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 heights :: [Int]
heights ws :: 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 win :: 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 = 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 text :: [(Point, Char)]
text [] = [(Point, Char)]
text
spliceAnnots text :: [(Point, Char)]
text (Span start :: Point
start x :: String
x stop :: Point
stop:anns :: [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 (l :: [(Point, Char)]
l,rest :: [(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
          (_,r :: [(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 leftMost :: Point
leftMost _ _:_) = 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 prev :: Point
prev [] = [(Point
prev,a -> a
forall a. a -> a
id)]
          helper prev :: Point
prev (Span l :: Point
l f :: Endo a
f r :: Point
r:xs :: [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 f0 :: a -> a
f0 _  [] lx :: [(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 _  x0 :: a
x0 lf :: [(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 f0 :: a -> a
f0 x0 :: a
x0 lf :: [(Point, a -> a)]
lf@((pf :: Point
pf,f :: a -> a
f):tf :: [(Point, a -> a)]
tf) lx :: [(Point, a)]
lx@((px :: Point
px,x :: a
x):tx :: [(Point, a)]
tx) =
  case Point
pf Point -> Point -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` Point
px of
    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
    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
    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
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 sty :: UIStyle
sty mexp :: Maybe SearchExp
mexp region :: Region
region extraLayers :: [[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 sty :: UIStyle
sty mexp :: Maybe SearchExp
mexp region :: 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 reg :: 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 items :: [Text]
items _ _ | (Text -> Bool) -> [Text] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Text -> Bool
T.null [Text]
items = []
arrangeItems items :: [Text]
items maxWidth :: Int
maxWidth maxNumberOfLines :: 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 [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' items' :: [Text]
items' maxWidth :: Int
maxWidth numberOfLines :: 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 (\x :: Int
x y :: Int
y -> 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) 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
(+) 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