module Bookhound.Utils.Foldable where

import Bookhound.Utils.String (indent)
import Control.Monad          (join)
import Data.Foldable          as Foldable (Foldable (toList), find)
import Data.List              (intercalate)
import Data.Maybe             (isJust)


hasNone :: Foldable m => m a -> Bool
hasNone :: forall (m :: * -> *) a. Foldable m => m a -> Bool
hasNone = forall (t :: * -> *) a. Foldable t => t a -> Bool
null

hasSome :: Foldable m => m a -> Bool
hasSome :: forall (m :: * -> *) a. Foldable m => m a -> Bool
hasSome = Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. Foldable m => m a -> Bool
hasNone

hasMultiple :: Foldable m => m a -> Bool
hasMultiple :: forall (m :: * -> *) a. Foldable m => m a -> Bool
hasMultiple m a
xs = forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all forall (m :: * -> *) a. Foldable m => m a -> Bool
hasSome forall a b. (a -> b) -> a -> b
$ [forall a. a -> a
id, forall a. [a] -> [a]
tail] forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [forall (t :: * -> *) a. Foldable t => t a -> [a]
toList m a
xs]


stringify :: Foldable m => String -> String -> String -> Int -> m String -> String
stringify :: forall (m :: * -> *).
Foldable m =>
String -> String -> String -> Int -> m String -> String
stringify String
sep String
start String
end Int
n m String
xs = String
start forall a. Semigroup a => a -> a -> a
<> Int -> String -> String
indent Int
n String
str forall a. Semigroup a => a -> a -> a
<> String
end
  where
    str :: String
str = forall a. [a] -> [[a]] -> [a]
intercalate String
sep [String]
list
    list :: [String]
list = forall (t :: * -> *) a. Foldable t => t a -> [a]
toList m String
xs

findJust :: Foldable t => t (Maybe a) -> Maybe a
findJust :: forall (t :: * -> *) a. Foldable t => t (Maybe a) -> Maybe a
findJust t (Maybe a)
ms = forall (m :: * -> *) a. Monad m => m (m a) -> m a
join forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
Foldable.find forall a. Maybe a -> Bool
isJust t (Maybe a)
ms