Typeclasses.hs

{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE DeriveTraversable #-}
{-# LANGUAGE DeriveFoldable #-}
{-# LANGUAGE TupleSections #-}
module Typeclasses where
import Data.Either
import Data.Monoid
import Data.Foldable
import Data.Bifunctor

data Tree a = Node (Tree a) (Tree a) | Leaf a
    deriving (Eq, Show, Functor, Foldable, Traversable)

-- | Return any values "inside" just, ignoring the "nothing"s.
--
-- >>> anyJust [Just 1, Nothing, Just 2]
-- [1,2]
--
-- >>> anyJust [Nothing]
-- []
--
-- >>> anyJust $ Node (Node (Leaf $ Just 1) (Leaf $ Just 2)) (Leaf $ Just 3)
-- [1,2,3]
--
-- >>> anyJust $ Node (Node (Leaf Nothing) (Leaf Nothing)) (Leaf Nothing)
-- []
--
-- >>> anyJust $ Node (Node (Leaf $ Left "First error") (Leaf $ Left "Second error")) (Leaf $ Left "Third error")
-- []
--
anyJust :: (Traversable m, Functor t, Foldable t) => t (m a) -> [a]
anyJust = foldMap toList

-- | Return a structure containing all of the "just" / "right" values
--
-- >>> allJust [Just 1, Just 2]
-- Just [1,2]
--
-- >>> allJust $ Node (Node (Leaf $ Just 1) (Leaf $ Just 2)) (Leaf $ Just 3)
-- Just (Node (Node (Leaf 1) (Leaf 2)) (Leaf 3))
--
-- >>> allJust [Just 1, Nothing]
-- Nothing
--
-- >>> allJust $ Node (Leaf Nothing) (Leaf $ Just 3)
-- Nothing
--
allJust :: (Monad m, Traversable t) => t (m a) -> m (t a)
allJust = sequence

-- | Returns the first "Just" from a strucutre of Justs, or Nothing otherwise.
--
-- >>> firstJust [Nothing, Just 1, Just 2]
-- Just 1
--
-- >>> firstJust [Nothing]
-- Nothing
--
-- >>> firstJust $ Node (Node (Leaf Nothing) (Leaf $ Just 1)) (Leaf $ Just 2)
-- Just 1
--
-- >>> firstJust $ Node (Node (Leaf Nothing) (Leaf Nothing)) (Leaf Nothing)
-- Nothing
--
firstJust :: (Functor t, Foldable t) => t (Maybe a) -> Maybe a
firstJust = getFirst . foldMap First 

-- | Returns the last "Just" from a strucutre of Justs, or Nothing otherwise.
--
-- >>> lastJust [Nothing, Just 1, Just 2]
-- Just 2
--
-- >>> lastJust [Nothing]
-- Nothing
--
-- >>> lastJust $ Node (Node (Leaf Nothing) (Leaf $ Just 1)) (Leaf $ Just 2)
-- Just 2
--
-- >>> lastJust $ Node (Node (Leaf Nothing) (Leaf Nothing)) (Leaf Nothing)
-- Nothing
--
lastJust :: (Functor t, Foldable t) => t (Maybe a) -> Maybe a
lastJust = getLast . foldMap Last


-- | Try to do something, then return a list of errors and a list of successful results.
--
-- >>> partition $ Node (Node (Leaf $ Left "First error") (Leaf $ Left "Second error")) (Leaf $ Right 3)
-- (["First error","Second error"],[3])
--
partition :: (Functor t, Foldable t) => t (Either a b) -> ([a], [b])
partition = foldMap toTuple
    where toTuple = either (\x -> ([x], [])) (\x -> ([], [x]))

-- | A more general version of partition; works with other things like "First" and "Last", too.
--
-- | We can, for instance, pick the first error and the first correct result.
--
-- >>> bimap getFirst getFirst $ partition' $ Node (Node (Leaf $ Left "First error") (Leaf $ Left "Second error")) (Leaf $ Right 3)
-- (Just "First error",Just 3)
--
-- | Or the last error and the last correct result.
--
-- >>> bimap getLast getLast $ partition' $ Node (Node (Leaf $ Left "First error") (Leaf $ Left "Second error")) (Leaf $ Right 3)
-- (Just "Second error",Just 3)
--
-- | Or, just like the original version, all the errors and all the correct results.
--
-- >>> partition' $ Node (Node (Leaf $ Left "First error") (Leaf $ Left "Second error")) (Leaf $ Right 3) :: ([String],[Int])
-- (["First error","Second error"],[3])

partition' :: (Functor t, Foldable t, Applicative m, Monoid (m a), Monoid (m b)) => t (Either a b) -> (m a, m b)
partition' = foldMap toTuple
    where toTuple = either ((,mempty) . pure) ((mempty,) . pure)