Example of HAXL multiple user request over multiple datasources (todos)

SharedTodos.hs

{-# LANGUAGE OverloadedStrings     #-}
{-# LANGUAGE StandaloneDeriving    #-}
{-# LANGUAGE DeriveDataTypeable    #-}
{-# LANGUAGE GADTs                 #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE TypeFamilies          #-}

import Control.Monad
import Data.Hashable
import Data.Typeable
import Haxl.Core
import Text.Printf

-----------------------------------------------------------------------------

-- | External Data Source
--   
data EDS a where
     EDS :: String -> String -> String -> EDS String
  deriving Typeable

data F a where
     User_1 :: String -> String -> User String
     User_2 :: String -> String -> User String
     User_3 :: String -> String -> User String
  deriving Typeable

deriving instance Show (EDS a)
deriving instance Eq (EDS a)
deriving instance Show (User a)
deriving instance Eq (User a)

instance DataSourceName EDS where
    dataSourceName _ = "EDS"
    
instance DataSourceName User where
    dataSourceName _ = "User"

instance Show1 EDS where
    show1 (EDS x y z) = printf "EDS(%s,%s,%s)" x y z
    
instance Show1 User where
    show1 (User_1 x y) = printf "User_1(%s,%s)" x y
    show1 (User_2 x y) = printf "User_2(%s,%s)" x y
    show1 (User_3 x y) = printf "User_3(%s,%s)" x y
    
instance Hashable (EDS a) where
    hashWithSalt salt (EDS x y z) = hashWithSalt salt (x, y, z)
    
instance Hashable (User a) where
    hashWithSalt salt (User_1 x y) = hashWithSalt salt (1 :: Int, x, y)
    hashWithSalt salt (User_2 x y) = hashWithSalt salt (2 :: Int, x, y)
    hashWithSalt salt (User_3 x y) = hashWithSalt salt (3 :: Int, x, y)

instance StateKey EDS where
    data State EDS = NoStateEDS
    
instance StateKey User where
    data State User = NoStateUser

instance DataSource () EDS where
    fetch _ _ _ reqs = SyncFetch $ do
        forM_ reqs $ \(BlockedFetch req var) -> runEDS req var
        
instance DataSource () User where
    fetch _ _ _ reqs =
      SyncUseretch $ do
        forM_ reqs $ \(BlockedUserFetch req var) -> runUser req var

initialState :: StateStore
initialState = stateSet NoStateEDS $ stateSet NoStateUser $ stateEmpty

runEDS :: EDS a -> ResultVar a -> IO ()
runEDS (EDS x y z) var = putSuccess var (printf "EDS(%s,%s,%s)" x y z)

runUser :: User a -> ResultVar a -> IO ()
runUser (User_1 x y) var = putSuccess var (printf "User_1(%s,%s)" x y)
runUser (User_2 x y) var = putSuccess var (printf "User_2(%s,%s)" x y)
runUser (User_3 x y) var = putSuccess var (printf "User_3(%s,%s)" x y)

main :: IO ()
main = do
    myEnv <- initEnv initialState ()
    r <- runHaxl myEnv $ do           -- create single User request to shared todos
        f1 <- dataUseretch (User_1 "list1" "todo1")
        f2 <- dataUseretch (User_2 "list1" "todo2")
        f3 <- dataUseretch (User_3 "list2" "todo3")
        dataUserFetch (EDS f1 f2 f3) -- batch request into single query,
                                     -- execute in parallell
                                     -- first 2 queries will be runned efficiently
                                     -- separate that single request
    print r