    {-# 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 :: forall (t :: * -> *).
    Traversable t =>
    [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)
    forall (m :: * -> *) a b. 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 a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Window
    win{height = 1}
              else (do h <- ([Int] -> Int) -> m Int
    forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
    gets [Int] -> Int
    forall a. HasCallStack => [a] -> a
    head
                       modify tail
                       return win{height = 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 necessary.
    --   Precondition: Strokes are ordered and not overlapping.
    strokePicture :: [Span (Endo a)] -> [(Point,a -> a)]
    strokePicture :: forall a. [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 :: forall a. 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 :: forall a.
    (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 a b. (a -> b) -> [a] -> [b]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap ((a -> a) -> (Point, a) -> (Point, a)
    forall b c d. (b -> c) -> (d, b) -> (d, c)
    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 a b. (a -> b) -> [a] -> [b]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap (((a -> a) -> a) -> (Point, a -> a) -> (Point, a)
    forall b c d. (b -> c) -> (d, b) -> (d, c)
    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 :: forall a. a -> [[Span (Endo a)]] -> [(Point, a)]
    paintPicture a
    a = ([Span (Endo a)] -> [(Point, a)] -> [(Point, a)])
    -> [(Point, a)] -> [[Span (Endo a)]] -> [(Point, a)]
    forall a b. (a -> b -> b) -> b -> [a] -> b
    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
    -> [[Stroke]]
    -> BufferM [(Point, Attributes)]
    attributesPictureB UIStyle
    sty Maybe SearchExp
    mexp Region
    region [[Stroke]]
    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)])
    -> ([[Stroke]] -> [[Span (Endo Attributes)]])
    -> [[Stroke]]
    -> [(Point, Attributes)]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$>
        ([Stroke] -> [Span (Endo Attributes)])
    -> [[Stroke]] -> [[Span (Endo Attributes)]]
    forall a b. (a -> b) -> [a] -> [b]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap ((Stroke -> Span (Endo Attributes))
    -> [Stroke] -> [Span (Endo Attributes)]
    forall a b. (a -> b) -> [a] -> [b]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap (((UIStyle -> Endo Attributes) -> Endo Attributes)
    -> Stroke -> Span (Endo Attributes)
    forall a b. (a -> b) -> Span a -> Span b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap ((UIStyle -> Endo Attributes) -> UIStyle -> Endo Attributes
    forall a b. (a -> b) -> a -> b
    $ UIStyle
    sty))) ([[Stroke]] -> [(Point, Attributes)])
    -> ([[Stroke]] -> [[Stroke]])
    -> [[Stroke]]
    -> [(Point, Attributes)]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$>
        ([[Stroke]]
    extraLayers [[Stroke]] -> [[Stroke]] -> [[Stroke]]
    forall a. [a] -> [a] -> [a]
    ++) ([[Stroke]] -> [(Point, Attributes)])
    -> BufferM [[Stroke]] -> BufferM [(Point, Attributes)]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$>
        Maybe SearchExp -> Region -> BufferM [[Stroke]]
    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
        selReg <- BufferM Region
    getSelectRegionB
        showSel <- use highlightSelectionA
        rectSel <- use rectangleSelectionA
        let styliseReg Region
    reg = Point -> (UIStyle -> Endo Attributes) -> Point -> Stroke
    forall a. Point -> a -> Point -> Span a
    Span (Region -> Point
    regionStart Region
    reg) UIStyle -> Endo Attributes
    selectedStyle (Region -> Point
    regionEnd Region
    reg)
            extraLayers | Bool
    rectSel Bool -> Bool -> Bool
    && Bool
    showSel = ([Stroke] -> [[Stroke]] -> [[Stroke]]
    forall a. a -> [a] -> [a]
    :[]) ([Stroke] -> [[Stroke]])
    -> ([Region] -> [Stroke]) -> [Region] -> [[Stroke]]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Region -> Stroke) -> [Region] -> [Stroke]
    forall a b. (a -> b) -> [a] -> [b]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap Region -> Stroke
    styliseReg ([Region] -> [[Stroke]]) -> BufferM [Region] -> BufferM [[Stroke]]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Region -> BufferM [Region]
    blockifyRegion Region
    selReg
                        | Bool
    showSel            = [[Stroke]] -> BufferM [[Stroke]]
    forall a. a -> BufferM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return [[Region -> Stroke
    styliseReg Region
    selReg]]
                        | Bool
    otherwise          = [[Stroke]] -> BufferM [[Stroke]]
    forall a. a -> BufferM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return []
        attributesPictureB sty mexp region =<< 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 a b. (a -> b) -> [a] -> [b]
    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 a b. (a -> b) -> [a] -> [b]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap ([Int] -> Int
    forall a. Ord a => [a] -> a
    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 a b. (a -> b) -> [a] -> [b]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap String -> Int
    forall a. [a] -> 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 a b. (a -> b) -> [a] -> [b]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap [String] -> Int
    forall a. [a] -> 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. HasCallStack => [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