module Hunt.Utility
(
(.::), (.:::)
, head'
, foldM'
, foldlWithKeyM, foldrWithKeyM
, whenM
, catMaybesSet
, isLeft, isRight
, fromLeft, fromRight
, unbox, unboxM, isSingleton
, split
, partitionListByLength, partitionListByCount
, descending
, strip, stripl, stripr, stripWith
, escape
, showText
, object', (.=?), (.==), (.\.)
, TypeDummy
)
where
import Control.Monad (when)
import Data.Aeson hiding (decode)
import Data.Aeson.Types
import Data.Char
import qualified Data.Foldable as FB
import qualified Data.List as L
import Data.Map (Map)
import qualified Data.Map as M
import Data.Maybe (fromJust)
import Data.Set (Set)
import qualified Data.Set as S
import Data.Text (Text)
import qualified Data.Text as T
import Numeric (showHex)
data TypeDummy
showText :: Show a => a -> Text
showText = T.pack . show
(.::) :: (c -> d) -> (a -> b -> c) -> a -> b -> d
(.::) = (.).(.)
(.:::) :: (d -> e) -> (a -> b -> c -> d) -> a -> b -> c -> e
(.:::) = (.).(.).(.)
head' :: [a] -> Maybe a
head' xs = if null xs then Nothing else Just $ head xs
catMaybesSet :: Ord a => Set (Maybe a) -> [a]
catMaybesSet = S.toList . S.map fromJust . S.delete Nothing
isLeft :: Either a b -> Bool
isLeft = either (const True) (const False)
isRight :: Either a b -> Bool
isRight = not . isLeft
fromLeft :: Either a b -> a
fromLeft = either id (error "Hunt.Utility.fromLeft: Right")
fromRight :: Either a b -> b
fromRight = either (error "Hunt.Utility.fromRight: Left") id
unbox :: [a] -> a
unbox [e] = e
unbox _ = error "unbox: []"
unboxM :: [a] -> Maybe a
unboxM [e] = Just e
unboxM _ = Nothing
isSingleton :: [a] -> Bool
isSingleton [_] = True
isSingleton _ = False
split :: Eq a => [a] -> [a] -> [[a]]
split _ [] = [[]]
split at w@(x:xs) = maybe ((x:r):rs) ((:) [] . split at) (L.stripPrefix at w)
where (r:rs) = split at xs
strip :: String -> String
strip = stripWith isSpace
stripl :: String -> String
stripl = dropWhile isSpace
stripr :: String -> String
stripr = reverse . dropWhile isSpace . reverse
stripWith :: (a -> Bool) -> [a] -> [a]
stripWith f = reverse . dropWhile f . reverse . dropWhile f
partitionListByLength :: Int -> [a] -> [[a]]
partitionListByLength _ [] = []
partitionListByLength count l = take count l : partitionListByLength count (drop count l)
partitionListByCount :: Int -> [a] -> [[a]]
partitionListByCount = partition
where
partition 0 _ = []
partition sublists l
= let next = (length l `div` sublists)
in if next == 0 then [l]
else take next l : partition (sublists 1) (drop next l)
descending :: Ord a => a -> a -> Ordering
descending = flip compare
escape :: String -> String
escape [] = []
escape (c:cs)
= if isAlphaNum c || isSpace c
then c : escape cs
else '%' : showHex (fromEnum c) "" ++ escape cs
foldM' :: (Monad m) => (a -> b -> m a) -> a -> [b] -> m a
foldM' _ acc [] = return acc
foldM' f acc (x:xs) = do
!acc' <- f acc x
foldM' f acc' xs
foldrWithKeyM :: (Monad m) => (k -> a -> b -> m b) -> b -> Map k a -> m b
foldrWithKeyM f b = FB.foldrM (uncurry f) b . M.toList
foldlWithKeyM :: (Monad m) => (b -> k -> a -> m b) -> b -> Map k a -> m b
foldlWithKeyM f b = FB.foldlM f' b . M.toList
where f' a = uncurry (f a)
whenM :: Monad m => m Bool -> m () -> m ()
whenM bm f = bm >>= \b -> when b f
object' :: [[Pair]] -> Value
object' = object . Prelude.concat
(.=?) :: ToJSON a => Text -> (a, a -> Bool) -> [Pair]
name .=? (value, cond) = if cond value then [] else [ name .= value ]
(.==) :: ToJSON a => Text -> a -> [Pair]
name .== value = [ name .= value ]
(.\.) :: ToJSON a => a -> (a -> Bool) -> (a, a -> Bool)
v .\. c = (v,c)
infixl 8 .=?