Applicatives.hs

-- So basically, consider the follwing type class definition:

class Functor f => MonoidalApplicative f where
  unitA :: f ()
  pairA :: f a -> f b -> f (a,b)

-- We can make a Maybe instance like so:

instance MonoidalApplicative Maybe where
  unitA = Just ()
  pairA (Just x) (Just y) = Just (x,y)
  pairA _ _ = Nothing

-- The intuition for this is as follows:
-- Suppose you have some computation which might fail. For instance,
-- computing an arithmetic expression with division. It could fail
-- when you divide by zero. It can also fail in multiple places,
-- because arithmetic expressions have multiple parts. The `pairA`
-- function lets us aggregate and combinate multiple computations,
-- for instance the result of computing `1 * 2` and `3 / 0`, into
-- a single thing, which we can then operate on, such as by
-- performing addition to form the result of computing
-- `(1 * 2) + (3 / 0)`.
--
-- So here's a little calculator demonstrating this:

data Exp = Literal Int
         | Exp :+: Exp
         | Exp :-: Exp
         | Exp :*: Exp
         | Exp :/: Exp
  deriving (Show)

calculateMaybe :: Exp -> Maybe Int
calculateMaybe (Literal i) =
  fmap (const i) unitA
calculateMaybe (x :+: y) =
  fmap (uncurry (+)) (pairA (calculateMaybe x) (calculateMaybe y))
calculateMaybe (x :-: y) =
  fmap (uncurry (-)) (pairA (calculateMaybe x) (calculateMaybe y))
calculateMaybe (x :*: y) =
  fmap (uncurry (*)) (pairA (calculateMaybe x) (calculateMaybe y))
calculateMaybe (x :/: y) =
  fmap (uncurry div) (pairA (calculateMaybe x) (failIfZero (calculateMaybe y)))
  where
    failIfZero (Just 0) = Nothing
    failIfZero x = x

-- l = (Literal 1 :*: Literal 2)
-- r = calculate (Literal 3 :/: Literal 0)
-- calculate l == Just 2
-- calculate r == Nothing
-- calculate (l :+: r) == Nothing

-- The purpose of the `pairA` function is to act as an a means of
-- aggregating the results, while taking into account the effects
-- which in this case are failure. We can do this with lists too:

instance MonoidalApplicative [] where
  unitA = [()]
  pairA xs ys = [ (x,y) | x <- xs, y <- ys ]

-- Instead of calculating errors, let's try calculating
-- non-deterministic results. We'll make a little language for
-- regular expressions with just characters, sequencing, and
-- alternatives:

data SimpleRegexp = Symbol Char
                  | SimpleRegexp :>>: SimpleRegexp
                  | SimpleRegexp :|: SimpleRegexp
  deriving (Show)

-- Now let's enumerate elements in the regular expression, to see
-- what strings it matches:

enumerate :: SimpleRegexp -> [String]
enumerate (Symbol c) =
  fmap (const [c]) unitA
enumerate (l :>>: r) =
  fmap (uncurry (++)) (pairA (enumerate l) (enumerate r))
enumerate (l :|: r) =
  enumerate l ++ enumerate r

-- Now let's enumerate some things! Let's start with a simple one:
--
--   enumerate (Symbol 'a' :>>: Symbol 'b' :>>: Symbol 'c') == ["abc"]
--
-- Now let's add a isngle choice:
--
--   enumerate (Symbol 'a' :>>: Symbol 'b' :>>: (Symbol 'c' :|: Symbol 'd')) == ["abc", "abd"]
--
-- Now let's get more complicated:
--
--   enumerate ((Symbol 'a' :|: Symbol 'b') :>>: (Symbol 'c' :|: Symbol 'd')) == ["ac", "ad", "bc", "bd"]
--
-- Here you can see that the way we're aggregating with lists is by
-- combining multiple sub-results into all possible super-results.

-- The monoidal interface for Applicative is perfectly fine for
-- math, but it's inconvenient for programming, so usually we use
-- an equivalent definition:

infixl 3 <**>
class Functor f => TrueApplicative f where
  pureA :: a -> f a
  (<**>) :: f (a -> b) -> f a -> f b



instance TrueApplicative Maybe where
  pureA = Just
  Just f <**> Just x = Just (f x)
  _ <**> _ = Nothing

calculateMaybe2 :: Exp -> Maybe Int
calculateMaybe2 (Literal i) = pureA i
calculateMaybe2 (x :+: y) = pureA (+) <**> calculateMaybe2 x <**> calculateMaybe2 y
calculateMaybe2 (x :-: y) = pureA (-) <**> calculateMaybe2 x <**> calculateMaybe2 y
calculateMaybe2 (x :*: y) = pureA (*) <**> calculateMaybe2 x <**> calculateMaybe2 y
calculateMaybe2 (x :/: y) = pureA div <**> calculateMaybe2 x <**> failIfZero (calculateMaybe2 y)
  where
    failIfZero (Just 0) = Nothing
    failIfZero x = x



instance TrueApplicative [] where
  pureA x = [x]
  fs <**> xs = [ f x | f <- fs, x <- xs ]

enumerate2 :: SimpleRegexp -> [String]
enumerate2 (Symbol c) = pureA [c]
enumerate2 (l :>>: r) = pureA (++) <**> enumerate2 l <**> enumerate2 r
enumerate2 (l :|: r) = enumerate2 l ++ enumerate2 r


-- It turns out that `pureA f <**> x` is the same as `fmap f x`,
-- and it's a very common pattern. As a result, there's a special
-- infix version of `fmap` called `<$>` that we use to make the
-- code even tidier:

calculateMaybe3 :: Exp -> Maybe Int
calculateMaybe3 (Literal i) = pureA i
calculateMaybe3 (x :+: y) = (+) <$> calculateMaybe3 x <**> calculateMaybe3 y
calculateMaybe3 (x :-: y) = (-) <$> calculateMaybe3 x <**> calculateMaybe3 y
calculateMaybe3 (x :*: y) = (*) <$> calculateMaybe3 x <**> calculateMaybe3 y
calculateMaybe3 (x :/: y) = div <$> calculateMaybe3 x <**> failIfZero (calculateMaybe3 y)
  where
    failIfZero (Just 0) = Nothing
    failIfZero x = x

enumerate3 :: SimpleRegexp -> [String]
enumerate3 (Symbol c) = pureA [c]
enumerate3 (l :>>: r) = (++) <$> enumerate3 l <**> enumerate3 r
enumerate3 (l :|: r) = enumerate3 l ++ enumerate3 r

--  The general point of applicatives defined in this second way
-- is to make it easy for you to blur your eyes and pretend that
-- you're writing normal side-effectful programs. After all,
-- what would `calculateMaybe` look like, if we treated division
-- by zero as a true side effect?

calculate :: Exp -> Int
calculate (Literal i) = i
calculate (x :+: y) = (+) (calculate x) (calculate y)
calculate (x :-: y) = (-) (calculate x) (calculate y)
calculate (x :*: y) = (*) (calculate x) (calculate y)
calculate (x :/: y) = div (calculate x) (undefinedIfZero (calculate y))
  where
    undefinedIfZero 0 = undefined
    undefinedIfZero x = x

-- But since this is using Haskell's builtin error mechanism, we
-- cannot catch it. Haskell doesn't have built in constructs for
-- catching errors. And that's good! It means we can define our
-- own using Maybe:

tryCatchMaybe :: Maybe b -> Maybe b -> Maybe b
tryCatchMaybe (Just x) _ = Just x
tryCatchMaybe Nothing x = x