Demonstrating how to use the Haxl library.

Main.hs

{-# LANGUAGE DeriveDataTypeable, GADTs, MultiParamTypeClasses, OverloadedStrings, StandaloneDeriving, TypeFamilies #-}
import Control.Monad
import Data.Hashable
import Data.Typeable
import Haxl.Core
import Text.Printf


data E a where
    E :: String -> String -> E String
  deriving Typeable

data F a where
    F_1 :: String -> String -> F String
    F_2 :: String -> String -> F String
  deriving Typeable

runE :: E a -> ResultVar a -> IO ()
runE (E x y) var = putSuccess var (printf "E(%s,%s)" x y)

runF :: F a -> ResultVar a -> IO ()
runF (F_1 x y) var = putSuccess var (printf "F_1(%s,%s)" x y)
runF (F_2 x y) var = putSuccess var (printf "F_2(%s,%s)" x y)

deriving instance Show (E a)
deriving instance Show (F a)
deriving instance Eq (E a)
deriving instance Eq (F a)

instance DataSourceName E where
    dataSourceName _ = "E"
instance DataSourceName F where
    dataSourceName _ = "F"

instance Show1 E where
    show1 (E x y) = printf "E(%s,%s)" x y
instance Show1 F where
    show1 (F_1 x y) = printf "F_1(%s,%s)" x y
    show1 (F_2 x y) = printf "F_2(%s,%s)" x y

instance Hashable (E a) where
    hashWithSalt salt (E x y) = hashWithSalt salt (x, y)
instance Hashable (F a) where
    hashWithSalt salt (F_1 x y) = hashWithSalt salt (1 :: Int, x, y)
    hashWithSalt salt (F_2 x y) = hashWithSalt salt (2 :: Int, x, y)

instance StateKey E where
    data State E = NoStateE
instance StateKey F where
    data State F = NoStateF

traceRequests :: Show1 r => [BlockedFetch r] -> IO ()
traceRequests reqs = printf "Computing %s\n" (show strs)
  where
    strs = fmap showRequest reqs
    showRequest (BlockedFetch req _) = show1 req

instance DataSource () E where
    fetch _ _ _ reqs = SyncFetch $ do
        traceRequests reqs
        forM_ reqs $ \(BlockedFetch req var) -> runE req var
instance DataSource () F where
    fetch _ _ _ reqs = SyncFetch $ do
        traceRequests reqs
        forM_ reqs $ \(BlockedFetch req var) -> runF req var


initialState :: StateStore
initialState = stateSet NoStateE
             $ stateSet NoStateF
             $ stateEmpty


-- |
-- >>> main
-- Computing ["F_1(x,y)"]
-- Computing ["F_2(y,z)"]
-- Computing ["E(F_1(x,y),F_2(y,z))"]
-- "E(F_1(x,y),F_2(y,z))"
main :: IO ()
main = do
    myEnv <- initEnv initialState ()
    r <- runHaxl myEnv $ do
        f1 <- dataFetch (F_1 "x" "y")
        f2 <- dataFetch (F_2 "y" "z")
        dataFetch (E f1 f2)
    print r