mirror of
https://github.com/lagunoff/htmlt.git
synced 2024-10-04 02:47:08 +03:00
Add benchmarks
This commit is contained in:
parent
0e0bd874b7
commit
48e0dfb600
2
.gitignore
vendored
2
.gitignore
vendored
@ -24,5 +24,3 @@ locals.nix
|
||||
node_modules
|
||||
package.json
|
||||
yarn.lock
|
||||
benchmarks.jsexe
|
||||
benchmarks
|
17
8.10.7.nix
17
8.10.7.nix
@ -41,16 +41,21 @@ let
|
||||
foundation = cure super.foundation;
|
||||
basement = cure super.basement;
|
||||
gauge = cure super.gauge;
|
||||
http-api-data = cure super.http-api-data;
|
||||
network-uri = cure super.network-uri;
|
||||
};
|
||||
|
||||
ghcjsPackages = pkgs.haskell.packages.ghcjs810.override {
|
||||
mkPackages = self: super: super.override {
|
||||
overrides = lib.composeExtensions (self: super:
|
||||
lib.mapAttrs (k: v: self.callCabal2nix k v {}) (extraPackages super)
|
||||
) overrides;
|
||||
};
|
||||
in
|
||||
ghcjsPackages // {
|
||||
} // {
|
||||
shell = pkgs.mkShell {
|
||||
inputsFrom = [ghcjsPackages.htmlt.env];
|
||||
inputsFrom = [self.htmlt.env];
|
||||
};
|
||||
}
|
||||
};
|
||||
|
||||
in rec {
|
||||
ghcjs = mkPackages ghcjs pkgs.haskell.packages.ghcjs810;
|
||||
ghc = mkPackages ghc pkgs.haskellPackages;
|
||||
}
|
||||
|
24
8.6.0.nix
24
8.6.0.nix
@ -7,31 +7,43 @@ let
|
||||
inherit (pkgs) lib haskell;
|
||||
pkgs = import nixpkgs {};
|
||||
reflexPlatform = import reflexPlatformSrc {};
|
||||
cure = p: haskell.lib.dontCheck (haskell.lib.doJailbreak p);
|
||||
|
||||
reflexPlatformSrc = builtins.fetchGit {
|
||||
url = "https://github.com/reflex-frp/reflex-platform.git";
|
||||
rev = "f019863c21ee85498e6a6e0072e617b2462b70ed";
|
||||
};
|
||||
|
||||
ghcjsBaseDummySrc = builtins.fetchGit {
|
||||
url = "git@github.com:lagunoff/ghcjs-base-dummy.git";
|
||||
rev = "ec549b970fc7d0f8031e8f2fc943dac89e443f69";
|
||||
};
|
||||
|
||||
extraPackages = super: {
|
||||
gauge = builtins.fetchGit {
|
||||
url = "https://github.com/vincenthz/hs-gauge.git";
|
||||
rev = "3069be4752a4c0f2ac310e66b44d7929763da19c";
|
||||
};
|
||||
} // lib.optionalAttrs (!(super.ghc.isGhcjs or false)) {
|
||||
ghcjs-base = ghcjsBaseDummySrc;
|
||||
};
|
||||
|
||||
overrides = self: super: {
|
||||
htmlt = self.callCabal2nixWithOptions "htmlt" ./. "-fexamples" {};
|
||||
} // lib.optionalAttrs (!(super.ghc.isGhcjs or false)) {
|
||||
ghcjs-base = cure super.ghcjs-base;
|
||||
};
|
||||
|
||||
ghcjsPackages = reflexPlatform.ghcjs.override {
|
||||
mkPackages = self: super: super.override {
|
||||
overrides = lib.composeExtensions (self: super:
|
||||
lib.mapAttrs (k: v: self.callCabal2nix k v {}) (extraPackages super)
|
||||
) overrides;
|
||||
};
|
||||
in
|
||||
ghcjsPackages // {
|
||||
} // {
|
||||
shell = pkgs.mkShell {
|
||||
inputsFrom = [ghcjsPackages.htmlt.env];
|
||||
inputsFrom = [self.htmlt.env];
|
||||
};
|
||||
}
|
||||
};
|
||||
in rec {
|
||||
ghcjs = mkPackages ghcjs reflexPlatform.ghcjs;
|
||||
ghc = mkPackages ghc pkgs.haskellPackages;
|
||||
}
|
||||
|
28
benchmarks/benchmarks.hs
Normal file
28
benchmarks/benchmarks.hs
Normal file
@ -0,0 +1,28 @@
|
||||
import Control.Monad
|
||||
import Control.Monad.IO.Class
|
||||
import Gauge
|
||||
import HtmlT
|
||||
|
||||
main = defaultMain
|
||||
[ bench "benchDynamics 100 10 10" $ whnfIO (benchDynamics 100 10 10)
|
||||
, bench "benchDynamics 10 100 10" $ whnfIO (benchDynamics 10 100 10)
|
||||
, bench "benchDynamics 10 10 100" $ whnfIO (benchDynamics 10 10 100)
|
||||
]
|
||||
|
||||
benchDynamics :: Int -> Int -> Int -> IO ()
|
||||
benchDynamics eventsNum subsNum fireNum = startReactive do
|
||||
-- Create a bunch of 'DynRef's
|
||||
refsList <- forM [1..eventsNum] $ const (newRef (0 :: Int))
|
||||
outputRef <- newRef Nothing
|
||||
-- Sum all of their values into a single 'Dynamic' using
|
||||
-- 'Applicative' instance
|
||||
let sumDyn = fmap sum . sequenceA . fmap fromRef $ refsList
|
||||
-- Attach subsNum amount of subscriptions
|
||||
sequence_ $ take subsNum $ repeat $ subscribeAndWrite sumDyn outputRef
|
||||
-- And fire modification event for each 'DynRef' fireNum times
|
||||
forM_ [1..fireNum] $ const $
|
||||
forM_ refsList $ liftIO . sync . flip modifyRef succ
|
||||
where
|
||||
subscribeAndWrite from to = void $ subscribe (dynamic_updates from) $
|
||||
writeRef to . Just
|
||||
startReactive act = newReactiveEnv >>= flip runReactiveEnvT act
|
18
htmlt.cabal
18
htmlt.cabal
@ -94,12 +94,14 @@ library
|
||||
build-depends:
|
||||
base,
|
||||
ghcjs-base,
|
||||
ghcjs-prim,
|
||||
bytestring,
|
||||
containers,
|
||||
exceptions,
|
||||
mtl,
|
||||
text
|
||||
if impl(ghcjs)
|
||||
build-depends:
|
||||
ghcjs-prim,
|
||||
|
||||
executable htmlt-hello
|
||||
import: htmlt-common
|
||||
@ -128,7 +130,6 @@ executable htmlt-todomvc
|
||||
generic-lens,
|
||||
mtl,
|
||||
ghcjs-base,
|
||||
ghcjs-prim,
|
||||
htmlt,
|
||||
text,
|
||||
if !flag(examples)
|
||||
@ -150,7 +151,6 @@ executable htmlt-simple-routing
|
||||
generic-lens,
|
||||
mtl,
|
||||
ghcjs-base,
|
||||
ghcjs-prim,
|
||||
network-uri,
|
||||
http-api-data,
|
||||
htmlt,
|
||||
@ -158,3 +158,15 @@ executable htmlt-simple-routing
|
||||
if !flag(examples)
|
||||
buildable: False
|
||||
|
||||
executable htmlt-benchmarks
|
||||
import: htmlt-common
|
||||
main-is: benchmarks.hs
|
||||
hs-source-dirs: ./benchmarks/
|
||||
build-depends:
|
||||
base,
|
||||
htmlt,
|
||||
text,
|
||||
gauge,
|
||||
if !flag(examples)
|
||||
buildable: False
|
||||
|
||||
|
@ -11,7 +11,6 @@ import GHCJS.Types
|
||||
import HtmlT.Event
|
||||
|
||||
-- | HtmlT is nothing more than just a newtype over ReaderT HtmlEnv,
|
||||
-- that's all!
|
||||
newtype HtmlT m a = HtmlT {unHtmlT :: ReaderT HtmlEnv m a}
|
||||
deriving newtype (Functor, Applicative, Monad, MonadIO, MonadReader HtmlEnv
|
||||
, MonadFix, MonadCatch, MonadThrow, MonadMask, MonadTrans)
|
||||
|
Loading…
Reference in New Issue
Block a user