module Yi.Utils where
import Data.Binary
import Data.Foldable hiding (all,any)
import Data.Default
import qualified Data.HashMap.Strict as HashMap
import Data.Hashable(Hashable)
import Control.Monad.Base
import Control.Applicative
import Control.Lens hiding (cons)
import qualified Data.Set as Set
import qualified Data.Map as Map
import qualified Data.List.PointedList as PL
io :: MonadBase IO m => IO a -> m a
io = liftBase
fst3 :: (a,b,c) -> a
fst3 (x,_,_) = x
snd3 :: (a,b,c) -> b
snd3 (_,x,_) = x
trd3 :: (a,b,c) -> c
trd3 (_,_,x) = x
class SemiNum absolute relative | absolute -> relative where
(+~) :: absolute -> relative -> absolute
(-~) :: absolute -> relative -> absolute
(~-) :: absolute -> absolute -> relative
singleton :: a -> [a]
singleton x = [x]
list :: b -> (a -> [a] -> b) -> [a] -> b
list nil _ [] = nil
list _ cons' (x:xs) = cons' x xs
nubSet :: (Ord a) => [a] -> [a]
nubSet xss = f Set.empty xss
where
f _ [] = []
f s (x:xs) = if x `Set.member` s then f s xs else x : f (Set.insert x s) xs
mapAdjust' :: (Ord k) => (a -> a) -> k -> Map.Map k a -> Map.Map k a
mapAdjust' f = Map.alter f' where
f' Nothing = Nothing
f' (Just x) = let x' = f x in x' `seq` Just x'
mapFromFoldable :: (Foldable t, Ord k) => t (k, a) -> Map.Map k a
mapFromFoldable = foldMap (uncurry Map.singleton)
groupBy' :: (a -> a -> Bool) -> [a] -> [[a]]
groupBy' _ [] = []
groupBy' p l = s1 : groupBy' p s2 where
(s1, s2) = chain p l
chain :: (a -> a -> Bool) -> [a] -> ([a],[a])
chain _ [] = ([], [])
chain _ [e] = ([e], [])
chain q (e1 : es@(e2 : _))
| q e1 e2 = let (s1, s2) = chain q es in (e1 : s1, s2)
| otherwise = ([e1], es)
commonPrefix :: Eq a => [[a]] -> [a]
commonPrefix [] = []
commonPrefix strings
| any null strings = []
| all (== prefix) heads = prefix : commonPrefix tailz
| otherwise = []
where
(heads, tailz) = unzip [(h,t) | (h:t) <- strings]
prefix = head heads
findPL :: (a -> Bool) -> [a] -> Maybe (PL.PointedList a)
findPL p xs = go [] xs where
go _ [] = Nothing
go ls (f:rs) | p f = Just (PL.PointedList ls f rs)
| otherwise = go (f:ls) rs
swapFocus :: (PL.PointedList a -> PL.PointedList a) -> (PL.PointedList a -> PL.PointedList a)
swapFocus moveFocus xs =
let xs' = moveFocus xs
f1 = view PL.focus xs
f2 = view PL.focus xs'
in set PL.focus f1 . moveFocus . set PL.focus f2 $ xs
dummyPut :: a -> Put
dummyPut _ = return ()
dummyGet :: Default a => Get a
dummyGet = return def
instance (Eq k, Hashable k, Binary k, Binary v) => Binary (HashMap.HashMap k v) where
put x = put (HashMap.toList x)
get = HashMap.fromList <$> get
makeLensesWithSuffix s =
makeLensesWith (defaultRules & lensField .~ Just . (++s))