Skip to content

Instantly share code, notes, and snippets.

@gelisam gelisam/Main.hs
Last active Oct 5, 2017

Embed
What would you like to do?
Demonstrating how to use the Haxl library.
{-# LANGUAGE DeriveDataTypeable, GADTs, MultiParamTypeClasses, OverloadedStrings, StandaloneDeriving, TypeFamilies #-}
import Control.Applicative
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_2(y,z)","F_1(x,y)"]
-- 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,f2) <- liftA2 (,) (dataFetch (F_1 "x" "y"))
(dataFetch (F_2 "y" "z"))
dataFetch (E f1 f2)
print r
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
You can’t perform that action at this time.
You signed in with another tab or window. Reload to refresh your session. You signed out in another tab or window. Reload to refresh your session.