{-|
Description : Container utilities
-}
module Language.Haskell.Formatter.Toolkit.Visit
       (findJust, orderByKey, compose, halfZipWith,
        mapAccumulateLeftWithCreation)
       where
import qualified Data.Foldable as Foldable
import qualified Data.List as List
import qualified Data.Maybe as Maybe
import qualified Data.Monoid as Monoid
import qualified Data.Ord as Ord
import qualified Data.Traversable as Traversable

{-| @findJust f c@ returns the first non-'Nothing' value of @c@ mapped with @f@,
    or 'Nothing' if there is none. -}
findJust :: (Functor t, Foldable.Foldable t) => (a -> Maybe b) -> t a -> Maybe b
findJust :: (a -> Maybe b) -> t a -> Maybe b
findJust a -> Maybe b
function = t (Maybe b) -> Maybe b
forall (t :: * -> *) (f :: * -> *) a.
(Foldable t, Alternative f) =>
t (f a) -> f a
Foldable.asum (t (Maybe b) -> Maybe b) -> (t a -> t (Maybe b)) -> t a -> Maybe b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Maybe b) -> t a -> t (Maybe b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> Maybe b
function

{-| @compose f@ returns the function composition of the elements of @f@. -}
compose :: Foldable.Foldable t => t (a -> a) -> a -> a
compose :: t (a -> a) -> a -> a
compose = Endo a -> a -> a
forall a. Endo a -> a -> a
Monoid.appEndo (Endo a -> a -> a)
-> (t (a -> a) -> Endo a) -> t (a -> a) -> a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((a -> a) -> Endo a) -> t (a -> a) -> Endo a
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
Foldable.foldMap (a -> a) -> Endo a
forall a. (a -> a) -> Endo a
Monoid.Endo

{-| @orderByKey k l@ orders @l@ by the sort keys generated by @k@. -}
orderByKey :: Ord b => (a -> b) -> [a] -> [a]
orderByKey :: (a -> b) -> [a] -> [a]
orderByKey = (a -> a -> Ordering) -> [a] -> [a]
forall a. (a -> a -> Ordering) -> [a] -> [a]
List.sortBy ((a -> a -> Ordering) -> [a] -> [a])
-> ((a -> b) -> a -> a -> Ordering) -> (a -> b) -> [a] -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> b) -> a -> a -> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
Ord.comparing

{-| @halfZipWith m b e@ zips the elements of @b@ and @e@ with @m@, using the
    structure of @b@. 'Nothing' is returned if and only if @b@ does not have
    enough elements. -}
halfZipWith ::
              (Traversable.Traversable t, Foldable.Foldable f) =>
              (a -> b -> c) -> t a -> f b -> Maybe (t c)
halfZipWith :: (a -> b -> c) -> t a -> f b -> Maybe (t c)
halfZipWith a -> b -> c
merge t a
base f b
extension = t (Maybe c) -> Maybe (t c)
forall (t :: * -> *) (f :: * -> *) a.
(Traversable t, Applicative f) =>
t (f a) -> f (t a)
Traversable.sequenceA t (Maybe c)
zippedMaybe
  where ([b]
_, t (Maybe c)
zippedMaybe) = ([b] -> a -> ([b], Maybe c)) -> [b] -> t a -> ([b], t (Maybe c))
forall (t :: * -> *) a b c.
Traversable t =>
(a -> b -> (a, c)) -> a -> t b -> (a, t c)
Traversable.mapAccumL [b] -> a -> ([b], Maybe c)
process [b]
extensionList t a
base
        process :: [b] -> a -> ([b], Maybe c)
process [] a
_ = ([], Maybe c
forall a. Maybe a
Nothing)
        process (b
extensionElement : [b]
list) a
baseElement
          = ([b]
list, c -> Maybe c
forall a. a -> Maybe a
Just (c -> Maybe c) -> c -> Maybe c
forall a b. (a -> b) -> a -> b
$ a -> b -> c
merge a
baseElement b
extensionElement)
        extensionList :: [b]
extensionList = f b -> [b]
forall (t :: * -> *) a. Foldable t => t a -> [a]
Foldable.toList f b
extension

{-| Like 'Traversable.mapAccumL', but with a function to create the base. -}
mapAccumulateLeftWithCreation ::
                                Traversable.Traversable t =>
                                (a -> b -> (a, c)) ->
                                  (b -> a) -> t b -> (Maybe a, t c)
mapAccumulateLeftWithCreation :: (a -> b -> (a, c)) -> (b -> a) -> t b -> (Maybe a, t c)
mapAccumulateLeftWithCreation a -> b -> (a, c)
process b -> a
createBase
  = (Maybe a -> b -> (Maybe a, c)) -> Maybe a -> t b -> (Maybe a, t c)
forall (t :: * -> *) a b c.
Traversable t =>
(a -> b -> (a, c)) -> a -> t b -> (a, t c)
Traversable.mapAccumL Maybe a -> b -> (Maybe a, c)
processMaybe Maybe a
forall a. Maybe a
Nothing
  where processMaybe :: Maybe a -> b -> (Maybe a, c)
processMaybe Maybe a
maybeBefore b
element = (a -> Maybe a
forall a. a -> Maybe a
Just a
after, c
element')
          where (a
after, c
element') = a -> b -> (a, c)
process a
before b
element
                before :: a
before = a -> Maybe a -> a
forall a. a -> Maybe a -> a
Maybe.fromMaybe (b -> a
createBase b
element) Maybe a
maybeBefore