Alternative instances

[michaelt]

The following race-like Alternative instance insane? The corresponding instance for FreeT would make IterT really reduce to FreeT Identity , since IterT uses such an instance.

instance Applicative v => Alternative (Free v) where
  empty = Free (pure empty)
  {-# INLINE empty #-}
  l <|> r = case l of
    Pure a -> Pure a
    Free a -> case r of 
      Pure b -> Pure b
      Free b -> Free (liftA2 (<|>) a b)
  {-# INLINE (<|>) #-}

It makes clear sense for e.g. Free ((,)a) where it would require a to be a monoid, and empty would thus be the infinite stream of memptys. When you (<|>) them, you append the elements monoidally as you go along, but then stop when either of them stops. In the case of ((->) a) mempty would be an infinite sink of 'a's. Maybe it's nonsense in other cases?

[mageshb]

Current Alternative instance for Free is giving un-intuitive result.
While interpreting ((getLn *> pure ()) <|> putLn "Actual: This should get printed") , I would expect
putLn to interpreted when there is failure in interpreting getLn. To get the behaviour I want, I had to re-define (<|>) for Free similar to the one above.
Is there a problem in defining Alternative instance for Free in a way that is being done in the following code?

#!/usr/bin/env stack
{- stack
  script
  --resolver nightly-2017-09-07
  --package free
-}
{-# LANGUAGE DeriveFunctor #-}
module Main where

import Control.Monad.Free as FreeM
import Control.Alternative.Free as FreeA
import Control.Applicative


data ActF f
  = GetLine (String -> f)
  | PutLine String f
  deriving (Functor)

type Action a = Free (Alt ActF) a

getLn :: Action String
getLn = liftF $ liftAlt $ GetLine id

putLn :: String -> Action ()
putLn s = liftF $ liftAlt $ PutLine s ()


run p = foldFree foldAlts p

foldAlts as = runAlt interpret as

interpret (PutLine s f) = putStrLn s >> (pure f)
interpret (GetLine f) = ioError $ userError "getline failed"

(<||>) :: (Alternative f) => Free f a ->  Free f a -> Free f a
(<||>) (FreeM.Pure alt1) _              = pure alt1
(<||>) (Free alt1) a2@(FreeM.Pure alt2) = FreeM.Free (alt1 <|> pure a2)
(<||>) (Free alt1) (Free alt2)          = FreeM.Free (alt1 <|> alt2)
infixl 3 <||>

actualCase = ((getLn *> pure ()) <|> putLn "Actual: This should get printed")  
expectedCase = ((getLn *> pure ()) <||> putLn "Expected: This should get printed")


main = do
  run expectedCase
  run actualCase

$./FreeAlt.hs
Expected: This should get printed
FreeAlt.hs: user error (mzero)

[mitchellwrosen]

I too wonder if @michaelt's instance is sane. Here's a use-case: "upgrading" the async Concurrently applicative to a monad, while inheriting its concurrent applicative and alternative behaviors.

import Control.Alternative.Free (Alt, liftAlt, runAlt)
import Control.Concurrent.Async (Concurrently(..))
import Control.Monad.Free.Ap -- Not quite, need the alternative Alternative instance

newtype Conc a
  = Conc { unConc :: Free (Alt Concurrently) a }
  deriving (Functor, Applicative, Alternative, Monad)

instance MonadIO Conc where
  liftIO = Conc . liftF . liftAlt . Concurrently

await :: Conc a -> IO a
await = foldFree (runConcurrently . runAlt id) . unConc

For example, this would run f1, then f2, f3 and f4 in parallel, using whichever of f2 and f3 finish first:

foo :: IO Int
foo = 
  await $ do
    i <- f1
    (j, k) <- liftA2 (,) (f2 <|> f3) f4
    pure (i + j + k)

EDIT: Oops, I realized today that this example doesn't need the free Alternative at all. But, it would still benefit from the alternate Alternative instance for Free.

[treeowl]

The proposed instance, and its extension to FreeT, certainly seem much more useful than the ones currently used for either Free or FreeT. My only major question is whether there's a good way to implement this for Control.Monad.Trans.Free.Church. Also, whether there's a good way to implement this for other "final" free monad transformer definitions like

type f ~> g = forall x. f x -> g x

newtype FF f m a = FF
  { runFF :: forall n. Monad n
      => (f ~> n) -- Any natural transformation
      -> (m ~> n) -- A monad morphism
      -> n a }

Maybe one of you wizards can find good approaches.

[treeowl]

Note to email followers: my last comment has been edited.