Delayed.hs

{-# language DeriveFunctor #-}
{-# language OverloadedStrings #-}
{-# language RankNTypes #-}
module Main where

import Control.Applicative
import Control.Monad
import Shelly

--------------------------------------------------------------------------------
newtype Delayed m a = Delay { runDelay :: Monad m => m (Maybe a) } deriving (Functor)

instance Functor m => Applicative (Delayed m) where
  pure x  = Delay (return $ Just x)
  (Delay f) <*> (Delay g) = Delay (f >>= \f' -> liftM2 ($) f' <$> g)

instance Applicative m => Alternative (Delayed m) where
  empty = Delay (return Nothing)
  (Delay a1) <|> (Delay a2) = Delay $ do
    r1 <- a1
    case r1 of
      Nothing -> a2
      Just x  -> return $ Just x


--------------------------------------------------------------------------------
expensive1 :: IO (Maybe Int)
expensive1 = do
  putStrLn "Expensive 1"
  return $ Just 1

--------------------------------------------------------------------------------
expensive2 :: IO (Maybe Int)
expensive2 = do
  putStrLn "Expensive 2"
  return $ Just 2

--------------------------------------------------------------------------------
ex1 :: Delayed Sh Int
ex1 = Delay $ verbosely $ do
  echo "Expensive 1"
  return $ Just 1

--------------------------------------------------------------------------------
ex2 :: Delayed Sh Int
ex2 = Delay $ verbosely $ do
  echo "Expensive 2"
  return $ Just 2

--------------------------------------------------------------------------------
main :: IO ()
main = do
  putStrLn "IO ====>"
  print =<< (expensive1 <|> expensive2)
  putStrLn "Delay ====>"
  print =<< (shelly $ runDelay (ex1 <|> ex2))