    {-# LANGUAGE FlexibleContexts #-}
    {-# LANGUAGE FunctionalDependencies #-}
    {-# OPTIONS_HADDOCK show-extensions #-}
    {-# OPTIONS_GHC -fno-warn-orphans #-} -- for Binary instance of Hashmap

    -- |
    -- Module      :  Yi.Utils
    -- License     :  GPL-2
    -- Maintainer  :  yi-devel@googlegroups.com
    -- Stability   :  experimental
    -- Portability :  portable
    --
    -- Various utility functions and instances used throughout Yi. Some of
    -- the functions from the now-removed Yi.Prelude found a new home
    -- here.

    module Yi.Utils where

    import           Lens.Micro.Platform
    import           Control.Monad.Base
    import           Data.Binary
    import           Data.Char (toLower)
    import qualified Data.HashMap.Strict as HashMap
    import           Data.Hashable(Hashable)
    import qualified Data.List.PointedList as PL
    import qualified Data.Map as Map
    import qualified Data.Set as Set
    import qualified Language.Haskell.TH.Syntax as THS

    io :: MonadBase IO m => IO a -> m a
    io :: forall (m :: * -> *) a. MonadBase IO m => IO a -> m a
    io = IO a -> m a
    forall α. IO α -> m α
    forall (b :: * -> *) (m :: * -> *) α. MonadBase b m => b α -> m α
    liftBase

    fst3 :: (a,b,c) -> a
    fst3 :: forall a b c. (a, b, c) -> a
    fst3 (a
    x,b
    _,c
    _) = a
    x

    snd3 :: (a,b,c) -> b
    snd3 :: forall a b c. (a, b, c) -> b
    snd3 (a
    _,b
    x,c
    _) = b
    x

    trd3 :: (a,b,c) -> c
    trd3 :: forall a b c. (a, b, c) -> c
    trd3 (a
    _,b
    _,c
    x) = c
    x

    class SemiNum absolute relative | absolute -> relative where
        (+~) :: absolute -> relative -> absolute
        (-~) :: absolute -> relative -> absolute
        (~-) :: absolute -> absolute -> relative

    {-# ANN nubSet "HLint: ignore Eta reduce" #-}
    -- TODO: move somewhere else.
    -- | As 'Prelude.nub', but with O(n*log(n)) behaviour.
    nubSet :: (Ord a) => [a] -> [a]
    nubSet :: forall a. Ord a => [a] -> [a]
    nubSet [a]
    xss = Set a -> [a] -> [a]
    forall {a}. Ord a => Set a -> [a] -> [a]
    f Set a
    forall a. Set a
    Set.empty [a]
    xss
      where
          f :: Set a -> [a] -> [a]
    f Set a
    _ [] = []
          f Set a
    s (a
    x:[a]
    xs) = if a
    x a -> Set a -> Bool
    forall a. Ord a => a -> Set a -> Bool
    `Set.member` Set a
    s then Set a -> [a] -> [a]
    f Set a
    s [a]
    xs else a
    x a -> [a] -> [a]
    forall a. a -> [a] -> [a]
    : Set a -> [a] -> [a]
    f (a -> Set a -> Set a
    forall a. Ord a => a -> Set a -> Set a
    Set.insert a
    x Set a
    s) [a]
    xs

    -- | As Map.adjust, but the combining function is applied strictly.
    mapAdjust' :: (Ord k) => (a -> a) -> k -> Map.Map k a -> Map.Map k a
    mapAdjust' :: forall k a. Ord k => (a -> a) -> k -> Map k a -> Map k a
    mapAdjust' a -> a
    f = (Maybe a -> Maybe a) -> k -> Map k a -> Map k a
    forall k a.
    Ord k =>
    (Maybe a -> Maybe a) -> k -> Map k a -> Map k a
    Map.alter Maybe a -> Maybe a
    f' where
        f' :: Maybe a -> Maybe a
    f' Maybe a
    Nothing = Maybe a
    forall a. Maybe a
    Nothing
        f' (Just a
    x) = let x' :: a
    x' = a -> a
    f a
    x in a
    x' a -> Maybe a -> Maybe a
    forall a b. a -> b -> b
    `seq` a -> Maybe a
    forall a. a -> Maybe a
    Just a
    x'
        -- This works because Map is structure-strict, and alter needs to force f' to compute
        -- the structure.

    -- | Generalisation of 'Map.fromList' to arbitrary foldables.
    mapFromFoldable :: (Foldable t, Ord k) => t (k, a) -> Map.Map k a
    mapFromFoldable :: forall (t :: * -> *) k a.
    (Foldable t, Ord k) =>
    t (k, a) -> Map k a
    mapFromFoldable = ((k, a) -> Map k a) -> t (k, a) -> Map k a
    forall m a. Monoid m => (a -> m) -> t a -> m
    forall (t :: * -> *) m a.
    (Foldable t, Monoid m) =>
    (a -> m) -> t a -> m
    foldMap ((k -> a -> Map k a) -> (k, a) -> Map k a
    forall a b c. (a -> b -> c) -> (a, b) -> c
    uncurry k -> a -> Map k a
    forall k a. k -> a -> Map k a
    Map.singleton)

    -- | Alternative to groupBy.
    --
    -- > groupBy' (\a b -> abs (a - b) <= 1) [1,2,3] = [[1,2,3]]
    --
    -- whereas
    --
    -- > groupBy (\a b -> abs (a - b) <= 1) [1,2,3] = [[1,2],[3]]
    --
    -- TODO: Check in ghc 6.12 release if groupBy == groupBy'.
    groupBy' :: (a -> a -> Bool) -> [a] -> [[a]]
    groupBy' :: forall a. (a -> a -> Bool) -> [a] -> [[a]]
    groupBy' a -> a -> Bool
    _ [] = []
    groupBy' a -> a -> Bool
    p [a]
    l = [a]
    s1 [a] -> [[a]] -> [[a]]
    forall a. a -> [a] -> [a]
    : (a -> a -> Bool) -> [a] -> [[a]]
    forall a. (a -> a -> Bool) -> [a] -> [[a]]
    groupBy' a -> a -> Bool
    p [a]
    s2 where
        ([a]
    s1, [a]
    s2) = (a -> a -> Bool) -> [a] -> ([a], [a])
    forall a. (a -> a -> Bool) -> [a] -> ([a], [a])
    chain a -> a -> Bool
    p [a]
    l

    chain :: (a -> a -> Bool) -> [a] -> ([a],[a])
    chain :: forall a. (a -> a -> Bool) -> [a] -> ([a], [a])
    chain a -> a -> Bool
    _ [] = ([], [])
    chain a -> a -> Bool
    _ [a
    e] = ([a
    e], [])
    chain a -> a -> Bool
    q (a
    e1 : es :: [a]
    es@(a
    e2 : [a]
    _))
        | a -> a -> Bool
    q a
    e1 a
    e2 = let ([a]
    s1, [a]
    s2) = (a -> a -> Bool) -> [a] -> ([a], [a])
    forall a. (a -> a -> Bool) -> [a] -> ([a], [a])
    chain a -> a -> Bool
    q [a]
    es in (a
    e1 a -> [a] -> [a]
    forall a. a -> [a] -> [a]
    : [a]
    s1, [a]
    s2)
        | Bool
    otherwise = ([a
    e1], [a]
    es)

    -- | Return the longest common prefix of a set of lists.
    --
    -- > P(xs) === all (isPrefixOf (commonPrefix xs)) xs
    -- > length s > length (commonPrefix xs) --> not (all (isPrefixOf s) xs)
    commonPrefix :: Eq a => [[a]] -> [a]
    commonPrefix :: forall a. Eq a => [[a]] -> [a]
    commonPrefix [] = []
    commonPrefix [[a]]
    strings
        | ([a] -> Bool) -> [[a]] -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    any [a] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [[a]]
    strings = []
        | (a -> Bool) -> [a] -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    all (a -> a -> Bool
    forall a. Eq a => a -> a -> Bool
    == a
    prefix) [a]
    heads = a
    prefix a -> [a] -> [a]
    forall a. a -> [a] -> [a]
    : [[a]] -> [a]
    forall a. Eq a => [[a]] -> [a]
    commonPrefix [[a]]
    tailz
        | Bool
    otherwise = []
        where
              ([a]
    heads, [[a]]
    tailz) = [(a, [a])] -> ([a], [[a]])
    forall a b. [(a, b)] -> ([a], [b])
    unzip [(a
    h,[a]
    t) | (a
    h:[a]
    t) <- [[a]]
    strings]
              prefix :: a
    prefix = [a] -> a
    forall a. HasCallStack => [a] -> a
    head [a]
    heads
    -- for an alternative implementation see GHC's InteractiveUI module.

    {-# ANN findPL "HLint: ignore Eta reduce" #-}
    ---------------------- PointedList stuff
    -- | Finds the first element satisfying the predicate, and returns a zipper pointing at it.
    findPL :: (a -> Bool) -> [a] -> Maybe (PL.PointedList a)
    findPL :: forall a. (a -> Bool) -> [a] -> Maybe (PointedList a)
    findPL a -> Bool
    p [a]
    xs = [a] -> [a] -> Maybe (PointedList a)
    go [] [a]
    xs where
      go :: [a] -> [a] -> Maybe (PointedList a)
    go [a]
    _  [] = Maybe (PointedList a)
    forall a. Maybe a
    Nothing
      go [a]
    ls (a
    f:[a]
    rs) | a -> Bool
    p a
    f    = PointedList a -> Maybe (PointedList a)
    forall a. a -> Maybe a
    Just ([a] -> a -> [a] -> PointedList a
    forall a. [a] -> a -> [a] -> PointedList a
    PL.PointedList [a]
    ls a
    f [a]
    rs)
                   | Bool
    otherwise = [a] -> [a] -> Maybe (PointedList a)
    go (a
    fa -> [a] -> [a]
    forall a. a -> [a] -> [a]
    :[a]
    ls) [a]
    rs

    {-# ANN swapFocus "HLint: ignore Redundant bracket" #-}
    -- | Given a function which moves the focus from index A to index B, return a function which swaps the elements at indexes A and B and then moves the focus. See Yi.Editor.swapWinWithFirstE for an example.
    swapFocus :: (PL.PointedList a -> PL.PointedList a) -> (PL.PointedList a -> PL.PointedList a)
    swapFocus :: forall a.
    (PointedList a -> PointedList a) -> PointedList a -> PointedList a
    swapFocus PointedList a -> PointedList a
    moveFocus PointedList a
    xs =
        let xs' :: PointedList a
    xs' = PointedList a -> PointedList a
    moveFocus PointedList a
    xs
            f1 :: a
    f1  = Getting a (PointedList a) a -> PointedList a -> a
    forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
    view Getting a (PointedList a) a
    forall (f :: * -> *) a.
    Functor f =>
    (a -> f a) -> PointedList a -> f (PointedList a)
    PL.focus PointedList a
    xs
            f2 :: a
    f2  = Getting a (PointedList a) a -> PointedList a -> a
    forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
    view Getting a (PointedList a) a
    forall (f :: * -> *) a.
    Functor f =>
    (a -> f a) -> PointedList a -> f (PointedList a)
    PL.focus PointedList a
    xs'
        in ASetter (PointedList a) (PointedList a) a a
    -> a -> PointedList a -> PointedList a
    forall s t a b. ASetter s t a b -> b -> s -> t
    set ASetter (PointedList a) (PointedList a) a a
    forall (f :: * -> *) a.
    Functor f =>
    (a -> f a) -> PointedList a -> f (PointedList a)
    PL.focus a
    f1 (PointedList a -> PointedList a)
    -> (PointedList a -> PointedList a)
    -> PointedList a
    -> PointedList a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . PointedList a -> PointedList a
    moveFocus (PointedList a -> PointedList a)
    -> (PointedList a -> PointedList a)
    -> PointedList a
    -> PointedList a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ASetter (PointedList a) (PointedList a) a a
    -> a -> PointedList a -> PointedList a
    forall s t a b. ASetter s t a b -> b -> s -> t
    set ASetter (PointedList a) (PointedList a) a a
    forall (f :: * -> *) a.
    Functor f =>
    (a -> f a) -> PointedList a -> f (PointedList a)
    PL.focus a
    f2 (PointedList a -> PointedList a) -> PointedList a -> PointedList a
    forall a b. (a -> b) -> a -> b
    $ PointedList a
    xs

    ----------------- Orphan 'Binary' instances
    instance (Eq k, Hashable k, Binary k, Binary v) => Binary (HashMap.HashMap k v) where
        put :: HashMap k v -> Put
    put HashMap k v
    x = [(k, v)] -> Put
    forall t. Binary t => t -> Put
    put (HashMap k v -> [(k, v)]
    forall k v. HashMap k v -> [(k, v)]
    HashMap.toList HashMap k v
    x)
        get :: Get (HashMap k v)
    get = [(k, v)] -> HashMap k v
    forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
    HashMap.fromList ([(k, v)] -> HashMap k v) -> Get [(k, v)] -> Get (HashMap k v)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Get [(k, v)]
    forall t. Binary t => Get t
    get

    makeClassyWithSuffix :: String -> THS.Name -> THS.Q [THS.Dec]
    makeClassyWithSuffix :: String -> Name -> Q [Dec]
    makeClassyWithSuffix String
    s = LensRules -> Name -> Q [Dec]
    makeLensesWith (LensRules
    classyRules
      LensRules -> (LensRules -> LensRules) -> LensRules
    forall a b. a -> (a -> b) -> b
    & ((Name -> [Name] -> Name -> [DefName])
     -> Identity (Name -> [Name] -> Name -> [DefName]))
    -> LensRules -> Identity LensRules
    Lens' LensRules (Name -> [Name] -> Name -> [DefName])
    lensField (((Name -> [Name] -> Name -> [DefName])
      -> Identity (Name -> [Name] -> Name -> [DefName]))
     -> LensRules -> Identity LensRules)
    -> (Name -> [Name] -> Name -> [DefName]) -> LensRules -> LensRules
    forall s t a b. ASetter s t a b -> b -> s -> t
    .~ (\Name
    _ [Name]
    _ Name
    n -> Name -> String -> [DefName]
    addSuffix Name
    n String
    s)
      LensRules -> (LensRules -> LensRules) -> LensRules
    forall a b. a -> (a -> b) -> b
    & ((Name -> Maybe (Name, Name))
     -> Identity (Name -> Maybe (Name, Name)))
    -> LensRules -> Identity LensRules
    Lens' LensRules (Name -> Maybe (Name, Name))
    lensClass (((Name -> Maybe (Name, Name))
      -> Identity (Name -> Maybe (Name, Name)))
     -> LensRules -> Identity LensRules)
    -> (Name -> Maybe (Name, Name)) -> LensRules -> LensRules
    forall s t a b. ASetter s t a b -> b -> s -> t
    .~ Name -> Maybe (Name, Name)
    classy)
      where
        classy :: THS.Name -> Maybe (THS.Name, THS.Name)
        classy :: Name -> Maybe (Name, Name)
    classy Name
    n = case Name -> String
    THS.nameBase Name
    n of
          Char
    x:String
    xs -> (Name, Name) -> Maybe (Name, Name)
    forall a. a -> Maybe a
    Just (String -> Name
    THS.mkName (String
    "Has" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ Char
    xChar -> String -> String
    forall a. a -> [a] -> [a]
    :String
    xs),
                        String -> Name
    THS.mkName (Char -> Char
    toLower Char
    x Char -> String -> String
    forall a. a -> [a] -> [a]
    : String
    xs String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    s))
          []   -> Maybe (Name, Name)
    forall a. Maybe a
    Nothing

    addSuffix :: THS.Name -> String -> [DefName]
    addSuffix :: Name -> String -> [DefName]
    addSuffix Name
    n String
    s = [Name -> DefName
    TopName (Name -> DefName) -> Name -> DefName
    forall a b. (a -> b) -> a -> b
    $ String -> Name
    THS.mkName (String -> Name) -> String -> Name
    forall a b. (a -> b) -> a -> b
    $ Name -> String
    THS.nameBase Name
    n String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    s]

    makeLensesWithSuffix :: String -> THS.Name -> THS.Q [THS.Dec]
    makeLensesWithSuffix :: String -> Name -> Q [Dec]
    makeLensesWithSuffix String
    s =
      LensRules -> Name -> Q [Dec]
    makeLensesWith (LensRules
    lensRules LensRules -> (LensRules -> LensRules) -> LensRules
    forall a b. a -> (a -> b) -> b
    & ((Name -> [Name] -> Name -> [DefName])
     -> Identity (Name -> [Name] -> Name -> [DefName]))
    -> LensRules -> Identity LensRules
    Lens' LensRules (Name -> [Name] -> Name -> [DefName])
    lensField (((Name -> [Name] -> Name -> [DefName])
      -> Identity (Name -> [Name] -> Name -> [DefName]))
     -> LensRules -> Identity LensRules)
    -> (Name -> [Name] -> Name -> [DefName]) -> LensRules -> LensRules
    forall s t a b. ASetter s t a b -> b -> s -> t
    .~ (\Name
    _ [Name]
    _ Name
    n -> Name -> String -> [DefName]
    addSuffix Name
    n String
    s))