-- SPDX-FileCopyrightText: 2020 Tocqueville Group
--
-- SPDX-License-Identifier: LicenseRef-MIT-TQ

-- | Utilities related to 'Alternative'.

module Util.Alternative
  ( someNE
  ) where

import qualified Data.List.NonEmpty as NE

-- | This function is the same as 'some' except that it returns
-- 'NonEmpty', because 'some' is guaranteed to return non-empty list,
-- but it's not captured in types.
someNE :: Alternative f => f a -> f (NonEmpty a)
someNE :: f a -> f (NonEmpty a)
someNE = ([a] -> NonEmpty a) -> f [a] -> f (NonEmpty a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [a] -> NonEmpty a
forall a. [a] -> NonEmpty a
NE.fromList (f [a] -> f (NonEmpty a))
-> (f a -> f [a]) -> f a -> f (NonEmpty a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. f a -> f [a]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
some