{-# LANGUAGE FlexibleContexts #-}
{-# OPTIONS_HADDOCK show-extensions #-}
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
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
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
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])
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