Instantly share code, notes, and snippets.

@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
f_1 :: GenHaxl () String -> GenHaxl () String -> GenHaxl () String
f_1 x y = join (dataFetch <$> (F_1 <$> x <*> y))
f_2 :: GenHaxl () String -> GenHaxl () String -> GenHaxl () String
f_2 x y = join (dataFetch <$> (F_1 <$> x <*> y))
e :: GenHaxl () String -> GenHaxl () String -> GenHaxl () String
e x y = join (dataFetch <$> (E <$> x <*> y))
-- |
-- >>> main
-- Computing ["F_1(y',z')","F_1(x',y')","F_1(y,z)","F_1(x,y)"]
-- Computing ["E(F_1(x',y'),F_1(y',z'))","E(F_1(x,y),F_1(y,z))"]
-- Computing ["E(E(F_1(x,y),F_1(y,z)),E(F_1(x',y'),F_1(y',z')))"]
-- "E(E(F_1(x,y),F_1(y,z)),E(F_1(x',y'),F_1(y',z')))"
main :: IO ()
main = do
myEnv <- initEnv initialState ()
r <- runHaxl myEnv $ e (e (f_1 x y) (f_2 y z))
(e (f_1 x' y') (f_2 y' z'))
print r
where
x, y, z, x', y', z' :: GenHaxl () String
x = pure "x"
y = pure "y"
z = pure "z"
x' = pure "x'"
y' = pure "y'"
z' = pure "z'"
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment