Applicatives e Traversable

> [1,2] + [3,4]
[4,5]
> (Just 3) + (Just 2)
Just 5

fmap0 :: a -> f a
fmap1 :: (a -> b) -> f a -> f b
fmap2 :: (a -> b -> c) -> f a -> f b -> f c
fmap3 :: (a -> b -> c -> d) -> f a -> f b -> f c -> f d

> fmap2 (+) [1,2] [3,4]
[4,5]
> fmap2 (+) (Just 3) (Just 2)
Just 5

pure   :: a -> f a
aplica :: f (a -> b) -> f a -> f b

fmap0 :: a -> fa
fmap0 = pure

fmap1 :: (a -> b) -> (f a -> f b)
fmap1 g x = aplica (pure g) x

fmap2 :: (a -> (b -> c)) -> (f a -> (f b -> f c))
fmap2 g x y = aplica (aplica (pure g) x) y

class Functor f => Applicative f where
  pure  :: a -> f a
  (<*>) :: f (a -> b) -> f a -> f b

> pure (+) <*> [1,2] <*> [3,4] -- não dá esse resultado
[4,6]
> pure (+) <*> (Just 3) <*> (Just 2)
Just 5

instance Applicative Maybe where
  pure             = Just
  Nothing  <*> _   = Nothing
  (Just g) <*> mx  = fmap g mx

r1 = maybeDiv x y
r2 = maybeDiv y x

-- Se alguma divisão falhar, retorna Nothing
-- Não precisamos criar um maybeAdd!
somaResultados = pure (+) <*> r1 <*> r2

pure (+) <*> maybeDiv 1 0 <*> maybeDiv 0 1

>>>
Nothing

instance Applicative [] where
  pure x    = [x]
  gs <*> xs = [g x | g <- gs, x <- xs]

pure (+1) <*> [1,2,3]

>>>
[2,3,4]

pure (+) <*> [1] <*> [2]

>>>
[3]

pure (*) <*> [1,2] <*> [3,4]

>>>
[3,4,6,8]

pure (++) <*> ["ha","heh","hmm"] <*> ["?","!","."]

>>>
["ha?","ha!","ha.","heh?","heh!","heh.","hmm?","hmm!","hmm."]

pure (*) <*> [1,2,3] <*> [2,3]

>>>
[2,3,4,6,6,9]

pure (*) <*> [1,2,3] <*> []

>>>
[]

-- Não dá esse resultado. Veja ZipList.
> pure (+) <*> [1,2,3] <*> [4,5]
[5,7]

import Control.Applicative
pure (+) <*> ZipList [1,2,3] <*> ZipList [4,5]

>>>
ZipList {getZipList = [5,7]}

instance Applicative SafeNum where
  pure = SafeNum
  f <*> x = flatten $ fmap (`fmap` x) f

-- Versão "pura"
f0 :: Int -> Int -> SafeNum Int
f0 x y
  | isSafe xy && isSafe yx = safeAdd (unbox xy) (unbox yx)
  | (not.isSafe) xy = xy
  | otherwise = yx
  where
    xy = safeDiv x y
    yx = safeDiv y x
    unbox (SafeNum a) = a
    isSafe (SafeNum _) = True
    isSafe _           = False

-- Versão com functors
f1 :: Int -> Int -> SafeNum Int
f1 x y =
  let xy = safeDiv x y
      yx = safeDiv y x
      safeAddXY = fmap safeAdd xy
      safeXYPlusYX = fmap (`fmap` yx) safeAddXY
  in
    (flatten.flatten) safeXYPlusYX

-- Versão com applicative
f2 :: Int -> Int -> SafeNum Int
f2 x y =
  let xy = safeDiv x y  -- SafeNum Int
      yx = safeDiv y x  -- SafeNum Int
  in
    flatten $ pure safeAdd <*> xy <*> yx

g :: a -> Maybe a

[g x1, g x2, g x3]

pure (:) <*> g x1 <*>
   (pure (:) <*> g x2 <*>
      (pure (:) <*> g x3 <*> pure []))

-- sequencia de Applicatives
sequenceA :: (Applicative f) => [f a] -> f [a]
sequenceA []     = pure []
sequenceA (x:xs) = pure (:) <*> x <*> sequenceA xs

sequenceA [Just 3, Just 2, Just 1]

>>>
Just [3,2,1]

sequenceA [Just 3, Nothing, Just 1]

>>>
Nothing

sequenceA [[1,2,3],[4,5,6]]

>>>
[[1,4],[1,5],[1,6],[2,4],[2,5],[2,6],[3,4],[3,5],[3,6]]

sequenceA [[1,2,3],[4,5,6],[3,4,4],[]]

>>>
[]

class (Functor t, Foldable t) => Traversable t where
  traverse :: Applicative f =>
                            (a -> f b) -> t a -> f (t b)

class (Functor t, Foldable t) => Traversable t where
  traverse :: Applicative f =>
                            (a -> f b) -> t a -> f (t b)

instance Traversable [] where
  traverse g []     = pure []
  traverse g (x:xs) = pure (:) <*> g x <*> traverse g xs

dec :: Int -> Maybe Int
dec x | x <= 0    = Nothing
      | otherwise = Just (x - 1)

traverse dec [1,2,3]

>>>
Just [0,1,2]

traverse dec [2,1,0]

>>>
Nothing

data Tree a = Leaf a | Node (Tree a) (Tree a)
              deriving Show

class (Functor t, Foldable t) => Traversable t where
   traverse :: Applicative f =>
                             (a -> f b) -> t a -> f (t b)

data Tree a = Leaf a | Node (Tree a) (Tree a)
              deriving Show

class (Functor t, Foldable t) => Traversable t where
   traverse :: Applicative f =>
                             (a -> f b) -> t a -> f (t b)

instance Traversable Tree where
   traverse g (Leaf x)   = pure Leaf <*> g x
   traverse g (Node l r) =
              pure Node <*> traverse g l <*> traverse g r

{-# LANGUAGE ExistentialQuantification #-}

data Fold i o = forall m . Monoid m => Fold (i -> m) (m -> o)

instance Functor (Fold i) where
 fmap k (Fold toMonoid summarize) = Fold toMonoid (k . summarize)

instance Applicative (Fold i) where
 pure o = Fold (\_ -> ()) (\_ -> o)

 Fold toMonoidF summarizeF <*> Fold toMonoidX summarizeX = Fold toMonoid summarize
   where
     toMonoid i = (toMonoidF i, toMonoidX i)

     summarize (mF, mX) = summarizeF mF (summarizeX mX)

sum :: Num n => Fold n n
sum = Fold Sum getSum

length :: Num n => Fold i n
length = Fold (\_ -> Sum 1) getSum

average :: Fractional n => Fold n n
average = (/) <$> sum <*> length