Keeping IO lazy under append - haskell

Question

I may have been under the false impression that Haskell is lazier than it is, but I wonder if there's a way to get the best of both worlds...
Data.Monoid and Data.Semigroup define two variations of First. The monoidal version models the leftmost, non-empty value, whereas the semigroup version simply models the leftmost value.
This works fine for pure value values, but consider impure values:
x = putStrLn "x" >> return 42
y = putStrLn "y" >> return 1337
Both of these values have the type Num a => IO a. IO a is a Semigroup instance when a is:
instance Semigroup a => Semigroup (IO a)
-- Defined in `Data.Orphans'
This means that it's possible to combine two IO (First a) values:
Prelude Data.Semigroup Data.Orphans> fmap First x <> fmap First y
x
y
First {getFirst = 42}
As we can see, though, both x and y produce their respective side-effects, even though y is never required.
The same applies for Data.Monoid:
Prelude Data.Monoid> fmap (First . Just) x <> fmap (First . Just) y
x
y
First {getFirst = Just 42}
I think I understand why this happens, given that both the Semigroup and Monoid instances use liftA2, which seems to ultimately be based on IO bind, which is strict, as far as I understand it.
If I dispense with the First abstraction(s), however, I can get lazier evaluation:
first x _ = x
mfirst x y = do
x' <- x
case x' of
(Just _) -> return x'
Nothing -> y
Using both of those ignores y:
Prelude> first x y
x
42
Prelude> mfirst (fmap Just x) (fmap Just y)
x
Just 42
In both of these cases, y isn't printed.
My question is, then:
Can I get the best of both worlds? Is there a way that I can retain the Semigroup or Monoid abstraction, while still get lazy IO?
Is there, for example, some sort of LazyIO container that I can wrap First values in, so that I get the lazy IO I'd like to have?
The actual scenario I'm after is that I'd like to query a prioritised list of IO resources for data, and use the first one that gives me a useful response. I don't, however, want to perform redundant queries (for performance reasons).

Answer 1

The Alternative instance for the MaybeT monad transformer returns the first successful result, and does not execute the rest of the operations. In combination with the asum function, we can write something like:
import Data.Foldable (asum)
import Control.Applicative
import Control.Monad.Trans.Maybe
action :: Char -> IO Char
action c = putChar c *> return c
main :: IO ()
main = do
result <- runMaybeT $ asum $ [ empty
, MaybeT $ action 'x' *> return Nothing
, liftIO $ action 'v'
, liftIO $ action 'z'
]
print result
where the final action 'z' won't be executed.
We can also write a newtype wrapper with a Monoid instance which mimics the Alternative:
newtype FirstIO a = FirstIO (MaybeT IO a)
firstIO :: IO (Maybe a) -> FirstIO a
firstIO ioma = FirstIO (MaybeT ioma)
getFirstIO :: FirstIO a -> IO (Maybe a)
getFirstIO (FirstIO (MaybeT ioma)) = ioma
instance Monoid (FirstIO a) where
mempty = FirstIO empty
FirstIO m1 `mappend` FirstIO m2 = FirstIO $ m1 <|> m2
The relationship between Alternative and Monoid is explained in this other SO question.

Answer 2

Is there a way that I can retain the Semigroup or Monoid abstraction, while still get lazy IO?
Somewhat, but there are drawbacks. The udnerlying problem for our instances is that a generic instance for an Applicative will look like
instance Semigroup a => Semigroup (SomeApplicative a) where
x <> y = (<>) <$> x <*> y
We're here at the mercy of (<*>), and usually the second argument y will be at least in WHNF. For example in Maybe's implementation the first line will work fine and the second line will error:
liftA2 (<>) Just (First 10) <> Just (error "never shown")
liftA2 (<>) Just (First 10) <> error "fire!"
IO's (<*>) is implemented in terms of ap, so the second action will always be executed before <> is applied.
A First-like variant is possible with ExceptT or similar, essentially any data type that has a Left k >>= _ = Left k like case so that we can stop the computation at that point. Although ExceptT is meant for exceptions, it may work well for your use-case. Alternatively, one of the Alternative transformers (MaybeT, ExceptT) together with <|> instead of <> might suffice.
A almost completely lazy IO type is also possible, but must be handled with care:
import Control.Applicative (liftA2)
import System.IO.Unsafe (unsafeInterleaveIO)
newtype LazyIO a = LazyIO { runLazyIO :: IO a }
instance Functor LazyIO where
fmap f = LazyIO . fmap f . runLazyIO
instance Applicative LazyIO where
pure = LazyIO . pure
f <*> x = LazyIO $ do
f' <- unsafeInterleaveIO (runLazyIO f)
x' <- unsafeInterleaveIO (runLazyIO x)
return $ f' x'
instance Monad LazyIO where
return = pure
f >>= k = LazyIO $ runLazyIO f >>= runLazyIO . k
instance Semigroup a => Semigroup (LazyIO a) where
(<>) = liftA2 (<>)
instance Monoid a => Monoid (LazyIO a) where
mempty = pure mempty
mappend = liftA2 mappend
unsafeInterleaveIO will enable the behaviour you want (and is used in getContents and other lazy IO Prelude functions), but it must be used with care. The order of IO operations is completely off at that point. Only when we inspect the values we will trigger the original IO:
ghci> :module +Data.Monoid Control.Monad
ghci> let example = fmap (First . Just) . LazyIO . putStrLn $ "example"
ghci> runLazyIO $ fmap mconcat $ replicateM 100 example
First {getFirst = example
Just ()}
Note that we only got our example once in the output, but at a completely random place, since the putStrLn "example" and print result got interleaved, since
print (First x) = putStrLn (show (First x))
= putStrLn ("First {getFirst = " ++ show x ++ "}")
and show x will finally put the IO necessary to get x in action. The action will get called only once if we use the result multiple times:
ghci> :module +Data.Monoid Control.Monad
ghci> let example = fmap (First . Just) . LazyIO . putStrLn $ "example"
ghci> result <- runLazyIO $ fmap mconcat $ replicateM 100 example
ghci> result
First {getFirst = example
Just ()}
ghci> result
First {getFirst = Just ()}
You could write a finalizeLazyIO function that either evaluates or seq's x though:
finalizeLazyIO :: LazyIO a -> IO a
finalizeLazyIO k = do
x <- runLazyIO k
x `seq` return x
If you were to publish a module with this functions, I'd recommend to only export the type constructor LazyIO, liftIO :: IO a -> LazyIO a and finalizeLazyIO.