@@ -0,0 +1,64 @@
1+{-# LANGUAGE DataKinds #-}
2+{-# LANGUAGE DeriveGeneric #-}
3+{-# LANGUAGE NamedFieldPuns #-}
4+{-# LANGUAGE RankNTypes #-}
5+{-# LANGUAGE RecordWildCards #-}
6+{-# LANGUAGE TypeApplications #-}
7+
8+module Main (main) where
9+
10+import Control.DeepSeq
11+import Control.Lens.Operators
12+import Control.Lens.Type
13+import Control.Monad
14+import Criterion.Main
15+import Data.Generics.Product
16+import GHC.Generics
17+import Test.QuickCheck
18+
19+main :: IO ()
20+main = 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+ ]
26+
27+products :: Int -> [Animal] -> Benchmark
28+products 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+ ]
35+
36+arbitraryAnimalsOfLength :: Int -> IO [Animal]
37+arbitraryAnimalsOfLength n
38+ = replicateM n (generate arbitrary)
39+
40+data Animal = Animal
41+ { name :: String
42+ , age :: Int
43+ , eats :: String
44+ } deriving (Generic, Show)
45+
46+instance Arbitrary Animal where
47+ arbitrary = Animal <$> arbitrary <*> arbitrary <*> arbitrary
48+
49+instance NFData Animal where
50+ rnf Animal{..} = rnf name `seq` rnf age `seq` rnf eats
51+
52+aName :: Lens' Animal String
53+aName f Animal{..}
54+ = (\x -> Animal { name = x, age, eats }) <$> f name
55+
56+{-
57+aAge :: Lens' Animal Int
58+aAge f Animal{..}
59+ = (\x -> Animal { name, age = x, eats }) <$> f age
60+
61+aEats :: Lens' Animal String
62+aEats f Animal{..}
63+ = (\x -> Animal { name, age, eats = x }) <$> f eats
64+ -}