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.