{-# LANGUAGE TupleSections #-}
module FoldableHelp
    ( safeMinimumOn
    , safeMinimumOnMaybe
    , safeMinimumOnMaybeF
    , safeMinimumOnMaybeL
    , safeMinMaybeL
    , filter3
    , takeUntil
    , ssfold
    , minOn
    , module Data.Foldable
    , minAndMax
    )
    where
import Data.Foldable

import qualified Control.Foldl as L

-- TODO check up whether and how it is necessary to specialise this
-- | A version of 'minimum' where the comparison is done on some extracted value.
--   Returns Nothing if the list is empty.
--
-- > safeMinimumOn id [] == Nothing
-- > safeMinimumOn length ["test","extra","a"] == Just "a"
safeMinimumOn :: (Foldable t,Ord b) => (a -> b) -> t a -> Maybe a
{-# INLINE safeMinimumOn #-}
safeMinimumOn f = foldl' g Nothing
  where
    g (Just x) y 
        | f x < f y = Just x
        | otherwise = Just y
    g Nothing y = Just y

minOn :: Ord b => (a -> b) -> a -> a -> a
minOn f x y
    | f x < f y = x
    | otherwise = y
safeMinimumOnMaybeF :: (Ord b) => (a -> Maybe b) -> [a] -> Maybe a
safeMinimumOnMaybeF f = L.fold $ L.Fold step initial extract
  where
    initial = Nothing
    step Nothing      x  = (x ,) <$> f x
    step (Just (a,x)) b = case f b of
        Just y | y < x  -> Just (b,y)
        _               -> Just (a,x)
    extract = fmap fst
safeMinMaybeL :: (Ord b) => (a -> Maybe b) -> L.Fold a (Maybe b)
safeMinMaybeL f = L.Fold step initial id
  where
    initial = Nothing
    step Nothing x  = f x
    step (Just x) b = case f b of
        Just y | y < x  -> Just y
        _               -> Just x

safeMinimumOnMaybeL :: (Ord b) => (a -> Maybe b) -> L.Fold a (Maybe a)
safeMinimumOnMaybeL f = L.Fold step initial extract
  where
    initial = Nothing
    step Nothing      x  = (x ,) <$> f x
    step (Just (a,x)) b = case f b of
        Just y | y < x  -> Just (b,y)
        _               -> Just (a,x)
    extract = fmap fst

safeMinimumOnMaybe :: (Ord b) => (a -> Maybe b) -> [a] -> Maybe a
safeMinimumOnMaybe f ys = fst <$> go Nothing ys
  where
    go Nothing (x:xs) = go ((x ,) <$> f x) xs
    go (Just (y,cmin)) (x:xs) = case f x of
        Just v | v < cmin -> go (Just (x,v)) xs
        _                 -> go (Just (y,cmin)) xs
    go m _ = m

filter3 :: Foldable t 
    => (a -> Bool) 
    -> (a -> Bool) 
    -> (a -> Bool)
    -> t a
    -> ([a],[a],[a])
filter3 t1 t2 t3 = L.fold $ (,,) 
    <$> L.prefilter t1 L.list 
    <*> L.prefilter t2 L.list
    <*> L.prefilter t3 L.list

--{- | Partial. -}
--minimumOn :: Ord b => (a -> b) -> [a] -> a
--minimumOn f [] = error "tried to take minimumOn of empty list"
--minimumOn f (x:xs) = go x xs
--  where
--    go x (y:xs) | f x < f y = go x xs
--                | otherwise = go y xs
--    go x [] = x

{- | Implementation copied from 
 - https://hackage.haskell.org/package/utility-ht-0.0.16/docs/src/Data.List.HT.Private.html#takeUntil
 -}
takeUntil :: Foldable t => (a -> Bool) -> t a -> [a]
takeUntil p = foldr (\x xs -> x : if p x then [] else xs) []

-- from haskell-cafe
-- short circuit a fold when a given property is satisfied
-- the fold builds a function that is then called on a0
ssfold :: Foldable t => (a -> Bool) -> (a -> b -> a) -> a -> t b -> a
{-# INLINABLE ssfold #-}
ssfold p f a0 xs = foldr (\x g a -> if p a then a else g (f a x)) id xs a0

minAndMax :: (Foldable t,Ord a) => t a -> (Maybe a,Maybe a)
minAndMax = L.fold ((,) <$> L.minimum <*> L.maximum)