@@ -0,0 +1,64 @@
1+{-# LANGUAGE DataKinds #-}
2+{-# LANGUAGE DeriveGeneric #-}
3+{-# LANGUAGE NamedFieldPuns #-}
4+{-# LANGUAGE RankNTypes #-}
5+{-# LANGUAGE RecordWildCards #-}
6+{-# LANGUAGE TypeApplications #-}
8+module Main (main) where
10+import Control.DeepSeq
11+import Control.Lens.Operators
12+import Control.Lens.Type
15+import Data.Generics.Product
17+import Test.QuickCheck
21+ [ env (arbitraryAnimalsOfLength 100) $ products 100
22+ , env (arbitraryAnimalsOfLength 1000) $ products 1000
23+ , env (arbitraryAnimalsOfLength 10000) $ products 10000
24+ , env (arbitraryAnimalsOfLength 100000) $ products 100000
27+products :: Int -> [Animal] -> Benchmark
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) ())
36+arbitraryAnimalsOfLength :: Int -> IO [Animal]
37+arbitraryAnimalsOfLength n
38+ = replicateM n (generate arbitrary)
44+ } deriving (Generic, Show)
46+instance Arbitrary Animal where
47+ arbitrary = Animal <$> arbitrary <*> arbitrary <*> arbitrary
49+instance NFData Animal where
50+ rnf Animal{..} = rnf name `seq` rnf age `seq` rnf eats
52+aName :: Lens' Animal String
54+ = (\x -> Animal { name = x, age, eats }) <$> f name
57+aAge :: Lens' Animal Int
59+ = (\x -> Animal { name, age = x, eats }) <$> f age
61+aEats :: Lens' Animal String
63+ = (\x -> Animal { name, age, eats = x }) <$> f eats