module Yi.UI.Utils where
import Yi.Buffer
import Yi.Prelude
import Prelude (Ordering(..))
import Yi.Window
import Control.Arrow (second)
import Data.Monoid
import Yi.Style
import Data.List (zip, repeat, span, dropWhile, length, zipWith, transpose, scanl, take, intercalate, takeWhile, reverse)
import Yi.Syntax (Span(..))
import Data.List.Split (chunksOf)
import Yi.String (padLeft)
import Control.Monad.State (runState,modify)
indexedAnnotatedStreamB :: Point -> BufferM [(Point, Char)]
indexedAnnotatedStreamB p = do
text <- indexedStreamB Forward p
annots <- withSyntaxB modeGetAnnotations
return $ spliceAnnots text (dropWhile (\s -> spanEnd s < p) (annots p))
applyHeights :: Traversable t => [Int] -> t Window -> t Window
applyHeights heights ws = fst $ runState (mapM distribute ws) heights
where distribute win = case isMini win of
True -> return win {height = 1}
False -> do h <- gets head
modify tail
return win {height = h}
spliceAnnots :: [(Point,Char)] -> [Span String] -> [(Point,Char)]
spliceAnnots text [] = text
spliceAnnots text (Span start x stop:anns) = l ++ zip (repeat start) x ++ spliceAnnots r anns
where (l,rest) = span ((start >) . fst) text
(_,r) = span ((stop >) . fst) rest
strokePicture :: [Span (Endo a)] -> [(Point,(a -> a))]
strokePicture [] = []
strokePicture wholeList@((Span leftMost _ _):_) = helper leftMost wholeList
where helper :: Point -> [Span (Endo a)] -> [(Point,(a -> a))]
helper prev [] = [(prev,id)]
helper prev ((Span l f r):xs)
| prev < l = (prev, id) : (l,appEndo f) : helper r xs
| otherwise = (l,appEndo f) : helper r xs
paintStrokes :: (a -> a) -> a -> [(Point,(a -> a))] -> [(Point,a)] -> [(Point,a)]
paintStrokes f0 _ [] lx = fmap (second f0) lx
paintStrokes _ x0 lf [] = fmap (second ($ x0)) lf
paintStrokes f0 x0 lf@((pf,f):tf) lx@((px,x):tx) =
case pf `compare` px of
LT -> (pf, f x0):paintStrokes f x0 tf lx
EQ -> (pf, f x ):paintStrokes f x tf tx
GT -> (px, f0 x ):paintStrokes f0 x lf tx
paintPicture :: a -> [[Span (Endo a)]] -> [(Point,a)]
paintPicture a = foldr (paintStrokes id a . strokePicture) []
attributesPictureB :: UIStyle -> Maybe SearchExp -> Region -> [[Span StyleName]] -> BufferM [(Point,Attributes)]
attributesPictureB sty mexp region extraLayers =
paintPicture (baseAttributes sty) <$>
fmap (fmap (fmap ($ sty))) <$>
(extraLayers ++) <$>
strokesRangesB mexp region
attributesPictureAndSelB :: UIStyle -> Maybe SearchExp -> Region -> BufferM [(Point,Attributes)]
attributesPictureAndSelB sty mexp region = do
selReg <- getSelectRegionB
showSel <- getA highlightSelectionA
rectSel <- getA rectangleSelectionA
let styliseReg reg = Span (regionStart reg) selectedStyle (regionEnd reg)
extraLayers | rectSel && showSel = (:[]) . fmap styliseReg <$> blockifyRegion selReg
| showSel = return [[styliseReg selReg]]
| otherwise = return []
attributesPictureB sty mexp region =<< extraLayers
arrangeItems :: [String] -> Int -> Int -> [String]
arrangeItems items maxWidth maxNumberOfLines = take maxNumberOfLines $ snd choice
where choice = maximumBy (compare `on` fst) arrangements
arrangements = fmap (arrangeItems' items maxWidth) (reverse [1..maxNumberOfLines])
arrangeItems' :: [String] -> Int -> Int -> (Int, [String])
arrangeItems' items maxWidth numberOfLines = (fittedItems,theLines)
where columns = chunksOf numberOfLines items
columnsWidth = fmap (maximum . fmap length) columns
totalWidths = scanl (\x y -> 1 + x + y) 0 columnsWidth
shownItems = scanl (+) 0 (fmap length columns)
fittedItems = snd $ last $ takeWhile ((<= maxWidth) . fst) $ zip totalWidths shownItems
theLines = fmap (intercalate " " . zipWith padLeft columnsWidth) $ transpose columns