on bfcd00a help sign in
64 lines 1.8 kB history raw
1{-# LANGUAGE DataKinds #-}
2{-# LANGUAGE DeriveGeneric #-}
3{-# LANGUAGE NamedFieldPuns #-}
4{-# LANGUAGE RankNTypes #-}
5{-# LANGUAGE RecordWildCards #-}
6{-# LANGUAGE TypeApplications #-}
8module Main (main) where
10import Control.DeepSeq
11import Control.Lens.Operators
12import Control.Lens.Type
13import Control.Monad
14import Criterion.Main
15import Data.Generics.Product
16import GHC.Generics
17import Test.QuickCheck
19main :: IO ()
20main = defaultMain
21 [ env (arbitraryAnimalsOfLength 100) $ products 100
22 , env (arbitraryAnimalsOfLength 1000) $ products 1000
23 , env (arbitraryAnimalsOfLength 10000) $ products 10000
24 , env (arbitraryAnimalsOfLength 100000) $ products 100000
25 ]
27products :: Int -> [Animal] -> Benchmark
28products n as
29 = bgroup ("products/" ++ show n)
30 [ bench "generic-lens/get" (nf (const $ map (^. field @"name") as) ())
31 , bench "lens/get" (nf (const $ map (^. aName) as) ())
32 , bench "generic-lens/set" (nf (const $ map (\a -> a & field @"name" .~ "Name") as) ())
33 , bench "lens/set" (nf (const $ map (\a -> a & aName .~ "Name") as) ())
34 ]
36arbitraryAnimalsOfLength :: Int -> IO [Animal]
37arbitraryAnimalsOfLength n
38 = replicateM n (generate arbitrary)
40data Animal = Animal
41 { name :: String
42 , age :: Int
43 , eats :: String
44 } deriving (Generic, Show)
46instance Arbitrary Animal where
47 arbitrary = Animal <$> arbitrary <*> arbitrary <*> arbitrary
49instance NFData Animal where
50 rnf Animal{..} = rnf name `seq` rnf age `seq` rnf eats
52aName :: Lens' Animal String
53aName f Animal{..}
54 = (\x -> Animal { name = x, age, eats }) <$> f name
56{-
57aAge :: Lens' Animal Int
58aAge f Animal{..}
59 = (\x -> Animal { name, age = x, eats }) <$> f age
61aEats :: Lens' Animal String
62aEats f Animal{..}
63 = (\x -> Animal { name, age, eats = x }) <$> f eats
64 -}