Haxl/tests/WorkDataSource.hs
Anubhav Bindlish 70f5bad436 Add writes to IORef in Env
Summary:
Here I try to populate the writes done as part of a Haxl computation
in an IORef inside the Environment.

`IVar` which is the synchornisation point,
also acts as the point where we store intermediate writes for Haxl
computations, so they can be memoized and reused whenever a memoized
computation is done again. This is done inside `getIVarWithWrites` function.

This works, because we create new IVars when running a memo computation
or a data fetch, and it is only at these places where we need to create a new
environment with empty writes to run the computation in. So I run every memoized
computation in a new environment (with empty writes) and populate the writes in this new
environment. At the end of the memoized computation, I look up these writes from the `IVar`
and also add them to the original environment. This way ultimately all writes are correctly
propagated upwards to the top level environment user passes to `runHaxl`.
This logic lives inside `execMemoNow`.

Reviewed By: simonmar

Differential Revision: D14342181

fbshipit-source-id: a410dae1a477f27b480804b67b2212e7500997ab
2019-04-10 09:48:57 -07:00

45 lines
1.1 KiB
Haskell

-- Copyright (c) 2014-present, Facebook, Inc.
-- All rights reserved.
--
-- This source code is distributed under the terms of a BSD license,
-- found in the LICENSE file.
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE FlexibleInstances #-}
module WorkDataSource (
work,
) where
import Haxl.Prelude
import Prelude ()
import Haxl.Core
import Haxl.DataSource.ConcurrentIO
import Control.Exception
import Data.Hashable
import Data.Typeable
work :: Integer -> GenHaxl u w Integer
work n = dataFetch (Work n)
data Work deriving Typeable
instance ConcurrentIO Work where
data ConcurrentIOReq Work a where
Work :: Integer -> ConcurrentIOReq Work Integer
performIO (Work n) = evaluate (sum [1..n]) >> return n
deriving instance Eq (ConcurrentIOReq Work a)
deriving instance Show (ConcurrentIOReq Work a)
instance ShowP (ConcurrentIOReq Work) where showp = show
instance Hashable (ConcurrentIOReq Work a) where
hashWithSalt s (Work n) = hashWithSalt s n