git.iko.soy/typeable/ether
on master help sign in
Nicer flatten-load syntax
commitf2e27155a357a974f4a2edf1ca762d825561f11b authorIndex Int <vlad.z.4096@gmail.com> dateSun 26 Jun 2016, 11:04 (10 years ago) parent97702d1
4 files changed+32−38
compare with master
unifiedsplit
.travis.yml+6−6 ether-flatten/src/Control/Ether/Flatten.hs+18−5 ether-suite/bench/Bench.hs+7−26 stack.yaml+1−1
.travis.yml+6−6
@@ -5,12 +5,12 @@ cache:
55 - $HOME/.stack/
66
77before_install:
8− - mkdir -p ~/.local/bin
9− - travis_retry curl -L https://github.com/commercialhaskell/stack/releases/download/v1.0.4.3/stack-1.0.4.3-linux-x86_64.tar.gz | tar -xvz
10− - mv stack-1.0.4.3-linux-x86_64/stack ~/.local/bin
11− - export PATH=~/.local/bin:$PATH
12− - stack --version
13− - stack setup
8+ - mkdir -p ~/.local/bin
9+ - travis_retry curl -L https://github.com/commercialhaskell/stack/releases/download/v1.1.2/stack-1.1.2-linux-x86_64.tar.gz | tar -xvz
10+ - mv stack-1.1.2-linux-x86_64/stack ~/.local/bin
11+ - export PATH=~/.local/bin:$PATH
12+ - stack --version
13+ - stack setup
1414
1515install:
1616 - stack install --only-dependencies --no-terminal
ether-flatten/src/Control/Ether/Flatten.hs+18−5
@@ -10,8 +10,10 @@
1010
1111module Control.Ether.Flatten
1212 ( HasLens(..)
13− , Product(..)
13+ , Product
1414 , load
15+ , type (++)
16+ , (<+>)
1517 ) where
1618
1719import Control.Lens
@@ -24,10 +26,21 @@ data Product (ts :: [k]) (as :: [*]) where
2426 Nil :: Product '[] '[]
2527 Cons :: !a -> !(Product ts as) -> Product (t ': ts) (a ': as)
2628
27−load
28− :: forall tag a tags as
29− . a -> Product tags as -> Product (tag ': tags) (a ': as)
30−load = Cons
29+load :: forall tag a . a -> Product '[tag] '[a]
30+load a = Cons a Nil
31+{-# INLINE load #-}
32+
33+type family (xs1 :: [k]) ++ (xs2 :: [k]) :: [k] where
34+ '[] ++ xs2 = xs2
35+ (a ': xs1) ++ xs2 = a ': (xs1 ++ xs2)
36+
37+(<+>)
38+ :: Product ts1 as1
39+ -> Product ts2 as2
40+ -> Product (ts1 ++ ts2) (as1 ++ as2)
41+Nil <+> as2 = as2
42+Cons a as1 <+> as2 = Cons a (as1 <+> as2)
43+{-# INLINE (<+>) #-}
3144
3245productHead ::
3346 Lens
ether-suite/bench/Bench.hs+7−26
@@ -31,9 +31,8 @@ readerSummatorMTL_flat_9 = do
3131
3232run_readerSummatorMTL_flat_9 :: (Int, Int, Int, Int, Int, Int, Int, Int, Int) -> String
3333run_readerSummatorMTL_flat_9
34− (a1, a2, a3, a4, a5, a6, a7, a8, a9)
35− = M.runReader readerSummatorMTL_flat_9
36− $ (a9, a8, a7, a6, a5, a4, a3, a2, a1)
34+ (a1, a2, a3, a4, a5, a6, a7, a8, a9) =
35+ M.runReader readerSummatorMTL_flat_9 (a9, a8, a7, a6, a5, a4, a3, a2, a1)
3736
3837readerSummatorEther_sep_9
3938 :: ( E.MonadReader 1 Int m
@@ -78,33 +77,15 @@ run_readerSummatorEther_flatten_9
7877 =
7978 E.F.runReader
8079 readerSummatorEther_sep_9
81− ( load @1 a9
82− . load @2 a8
83− . load @3 a7
84− . load @4 a6
85− . load @5 a5
86− . load @6 a4
87− . load @7 a3
88− . load @8 a2
89− . load @9 a1
90− $ Nil )
80+ ( load @1 a9 <+> load @2 a8 <+> load @3 a7 <+> load @4 a6 <+>
81+ load @5 a5 <+> load @6 a4 <+> load @7 a3 <+> load @8 a2 <+>
82+ load @9 a1 )
9183
9284run_readerSummatorEther_flattenhalf_9 :: (Int, Int, Int, Int, Int, Int, Int, Int, Int) -> String
9385run_readerSummatorEther_flattenhalf_9
9486 (a1, a2, a3, a4, a5, a6, a7, a8, a9)
95− = flip E.F.runReader
96− ( load @1 a9
97− . load @2 a8
98− . load @3 a7
99− . load @4 a6
100− $ Nil )
101− . flip E.F.runReaderT
102− ( load @5 a5
103− . load @6 a4
104− . load @7 a3
105− . load @8 a2
106− . load @9 a1
107− $ Nil )
87+ = flip E.F.runReader (load @1 a9 <+> load @2 a8 <+> load @3 a7 <+> load @4 a6)
88+ . flip E.F.runReaderT (load @5 a5 <+> load @6 a4 <+> load @7 a3 <+> load @8 a2 <+> load @9 a1)
10889 $ readerSummatorEther_sep_9
10990
11091tuple_9 :: (Int, Int, Int, Int, Int, Int, Int, Int, Int)
stack.yaml+1−1
@@ -1,4 +1,4 @@
1−resolver: nightly-2016-05-26
1+resolver: nightly-2016-06-21
22
33packages:
44- 'ether'