git.iko.soy/semi-iso-optics
on master help sign in
swap
de16c6d5 ahead, 0 behind
14 files changed+214−289
since splitsnapshots
unifiedsplit
.github/workflows/haskell.yml+7−6 .gitignore+15−39 Control/Category/Structures.hs−113 LICENSE+1 package.yaml+44 semi-iso.cabal−77 Control/Category/Reader.hs → src/Control/Category/Reader.hs+9−5 src/Control/Category/Structures.hs+31 Control/Lens/Internal/SemiIso.hs → src/Control/Lens/Internal/SemiIso.hs+5−3 Control/Lens/SemiIso.hs → src/Control/Lens/SemiIso.hs+18−11 Control/SIArrow.hs → src/Control/SIArrow.hs+7−29 Control/Tuple/Morph.hs → src/Control/Tuple/Morph.hs+1−1 Data/Profunctor/Exposed.hs → src/Data/Profunctor/Exposed.hs+7−5 stack.yaml+69
.github/workflows/haskell.yml+7−6
@@ -4,7 +4,7 @@ on: [pull_request]
44
55jobs:
66 build:
7−
7+
88 runs-on: ubuntu-latest
99
1010 steps:
@@ -12,10 +12,11 @@ jobs:
1212 - name: Install Stack
1313 run: |
1414 wget -qO- https://get.haskellstack.org/ | sh
15−# - name: Install dependencies
16−# run: cabal install --only-dependencies --enable-tests
15+
1716 - name: Build
1817 run: |
19− stack build --fast --pedantic
20−# - name: Run tests
21−# run: cabal test
18+ stack build --fast --pedantic --ghc-options '-j'
19+
20+ - name: Weeder
21+ run: |
22+ curl -sSL https://raw.github.com/ndmitchell/weeder/master/misc/run.sh | sh -s . --build
.gitignore+15−39
@@ -1,48 +1,24 @@
1−# Created by https://www.gitignore.io
2−
3−### Haskell ###
41dist
2+dist-*
53cabal-dev
64*.o
75*.hi
6+*.hie
87*.chi
98*.chs.h
10−.virtualenv
9+*.dyn_o
10+*.dyn_hi
11+.hpc
1112.hsenv
1213.cabal-sandbox/
1314cabal.sandbox.config
14−cabal.config
15−
16−
17−### Emacs ###
18−# -*- mode: gitignore; -*-
19−*~
20−\#*\#
21−/.emacs.desktop
22−/.emacs.desktop.lock
23−*.elc
24−auto-save-list
25−tramp
26−.\#*
27−
28−# Org-mode
29−.org-id-locations
30−*_archive
31−
32−# flymake-mode
33−*_flymake.*
34−
35−# eshell files
36−/eshell/history
37−/eshell/lastdir
38−
39−# elpa packages
40−/elpa/
41−
42−# reftex files
43−*.rel
44−
45−# AUCTeX auto folder
46−/auto/
47−
48−.stack-work
15+*.prof
16+*.aux
17+*.hp
18+*.eventlog
19+.stack-work/
20+cabal.project.local
21+cabal.project.local~
22+.HTF/
23+.ghc.environment.*
24+*.cabal
Control/Category/Structures.hsdeleted−113
@@ -1,113 +0,0 @@
1−{-# LANGUAGE TypeFamilies #-}
2−{-# LANGUAGE FlexibleInstances #-}
3−{-# LANGUAGE ConstraintKinds #-}
4−{- |
5−Module : Control.Category.Structures
6−Description : Structures in a category.
7−Copyright : (c) Paweł Nowak
8−License : MIT
9−
10−Maintainer : Paweł Nowak <pawel834@gmail.com>
11−Stability : experimental
12−
13−This module defines some basic structures in a category in a more fine-grained
14−way then "Control.Arrow".
15−
16−Unfortunately names in this module clash with "Control.Arrow".
17−-}
18−module Control.Category.Structures where
19−
20−import Control.Arrow (Kleisli(..))
21−import qualified Control.Arrow as BadArrow
22−import Control.Category
23−import Control.Monad
24−import Data.Semigroupoid.Dual
25−import Prelude hiding (id, (.))
26−
27−infixl 3 ***
28−infixl 2 +++
29−infixl 3 /+/
30−
31−-- | A category with finite products.
32−class Category cat => Products cat where
33− -- | Send the first component of the input through the argument arrow, and copy the rest unchanged to the output.
34− --
35− -- @first a@ is equal to @a *** id@.
36− first :: cat a b -> cat (a, c) (b, c)
37− first a = a *** id
38−
39− -- | A mirror image of 'first'.
40− --
41− -- @second a@ is equal to @id *** a@.
42− second :: cat a b -> cat (c, a) (c, b)
43− second a = id *** a
44−
45− -- | A product of two arrows.
46− -- Split the input between the two argument arrows and combine their output.
47− (***) :: cat a b -> cat c d -> cat (a, c) (b, d)
48− a *** b = first a >>> second b
49−
50− {-# MINIMAL (***) | first, second #-}
51−
52−instance Monad m => Products (Kleisli m) where
53− (***) = (BadArrow.***)
54−
55−instance Products cat => Products (Dual cat) where
56− Dual f *** Dual g = Dual $ second g >>> first f
57−
58−instance Products (->) where
59− (***) = (BadArrow.***)
60−
61−-- | A category with finite coproducts.
62−class Category cat => Coproducts cat where
63− -- | Feed marked inputs through the argument arrow, passing the rest through unchanged to the output.
64− --
65− -- @left a@ is equal to @a +++ id@.
66− left :: cat a b -> cat (Either a c) (Either b c)
67− left a = a +++ id
68−
69− -- | A mirror image of left.
70− --
71− -- @right a@ is equal to @id +++ a@.
72− right :: cat a b -> cat (Either c a) (Either c b)
73− right a = id +++ a
74−
75− -- | A coproduct of two arrows.
76− -- Split the input between the two argument arrows, retagging and merging their outputs.
77− (+++) :: cat a b -> cat c d -> cat (Either a c) (Either b d)
78− a +++ b = left a >>> right b
79−
80− {-# MINIMAL (+++) | left, right #-}
81−
82−instance Monad m => Coproducts (Kleisli m) where
83− (+++) = (BadArrow.+++)
84−
85−instance Coproducts cat => Coproducts (Dual cat) where
86− Dual f +++ Dual g = Dual $ right g >>> left f
87−
88−instance Coproducts (->) where
89− (+++) = (BadArrow.+++)
90−
91−-- | A category @cat@ is a CatPlus when @cat a b@ is a monoid for all a, b.
92−class Category cat => CatPlus cat where
93− -- | The identity of '/+/'.
94− cempty :: cat a b
95− -- | An associative operation on arrows.
96− (/+/) :: cat a b -> cat a b -> cat a b
97−
98− {-# MINIMAL cempty, (/+/) #-}
99−
100−instance MonadPlus m => CatPlus (Kleisli m) where
101− cempty = BadArrow.zeroArrow
102− (/+/) = (BadArrow.<+>)
103−
104−instance CatPlus cat => CatPlus (Dual cat) where
105− cempty = Dual cempty
106− Dual f /+/ Dual g = Dual $ f /+/ g
107−
108−-- | A category transformer.
109−class CatTrans t where
110− -- | Lift an arrow from the base category.
111− clift :: Category cat => cat a b -> t cat a b
112−
113− {-# MINIMAL clift #-}
LICENSE+1
@@ -1,4 +1,5 @@
11Copyright (c) 2014 Paweł Nowak
2+Copyright (c) 2019 Ilya Kostyuchenko
23
34Permission is hereby granted, free of charge, to any person obtaining
45a copy of this software and associated documentation files (the
package.yamlnew file+44
@@ -0,0 +1,44 @@
1+name: semi-iso
2+version: 0.1.0.0
3+github: "ilyakooo0/semi-iso-optics"
4+license: MIT
5+author: "Ilya Kostyuchenko"
6+maintainer: "ilyakooo0@gmail.com"
7+copyright: "2019 Ilya Kostyuchenko, 2014 Paweł Nowak"
8+
9+extra-source-files: []
10+
11+# Metadata used when publishing your package
12+# synopsis: Short description of your package
13+# category: Web
14+
15+# To avoid duplicated efforts in documentation and dealing with the
16+# complications of embedding Haddock markup inside cabal files, it is
17+# common to point users to the README.md file.
18+description: Please see the README on GitHub at <https://github.com/ilyakooo0/semi-iso-optics#readme>
19+
20+dependencies:
21+- base >= 4.7 && < 5
22+- profunctors
23+- lens
24+
25+library:
26+ source-dirs: src
27+ exposed-modules:
28+ - Control.Lens.SemiIso
29+ - Control.Lens.Internal.SemiIso
30+ - Control.SIArrow
31+ - Control.Category.Reader
32+ - Control.Category.Structures
33+ - Data.Profunctor.Exposed
34+ - Control.Tuple.Morph
35+ ghc-options:
36+ - -Wall
37+ - -Wincomplete-uni-patterns
38+ - -Wincomplete-record-updates
39+ - -Wpartial-fields
40+ - -Werror=missing-home-modules
41+ - -Wmissing-home-modules
42+ - -Widentities
43+ - -Wredundant-constraints
44+ - -Wmissing-export-lists
semi-iso.cabaldeleted−77
@@ -1,77 +0,0 @@
1−name: semi-iso
2−version: 1.0.0.0
3−synopsis: Weakened partial isomorphisms, reversible computations.
4−description:
5− Semi-isomorphisms are partial isomorphisms with weakened iso laws. They are a basic
6− building block of reversible computations. And they work with Iso and Prism from @lens@!
7− .
8− The module "Control.Lens.SemiIso" defines semi-isomorphisms and provides some
9− basic semi-isos and combinators. A @SemiIso' a b@ can be applied in both directions
10− to get a @a -> Either String b@ and @b -> Either String a@. SemiIsos can be composed
11− with Isos and Prisms (to get another SemiIso). Isos and Prisms can be directly
12− used as SemiIsos.
13− .
14− Semi-isomorphisms obey weaker laws then isomorphisms. We require only
15− .
16− > apply f >=> unapply f >=> apply f = apply f
17− > unapply f >=> apply f >=> unapply f = unapply f
18− .
19− instead of
20− .
21− > apply f >=> unapply f = f
22− > unapply f >=> apply f = f
23− .
24− Modules "Control.SIArrow" and "Control.Category.Structures" define an @Arrow@-like class
25− hierarchy. Unfortunately "Control.Arrow" cannot be used, as it is too restrictive (the
26− dreaded @arr@).
27−
28− SIArrow abstracts categories of reversible computations (with reversible side effects). In
29− the case of parsing and pretty-printing using the "syntax" library if we have an arrow
30− @SIArrow cat => cat a b@ then we can:
31− .
32− * Evaluate it from left to right, turning a value of type @a@ into a value of type @b@,
33− with the side effect of consuming a sequence. (Parsing)
34− .
35− * Evaluate it from right to left, turning a value of type @b@ into a value of type @a@,
36− with the side effect of generating a sequence. (Pretty-printing)
37− .
38− In the particular case of parsing/pretty-printing the type @a@ will be usually @()@, e.g.
39− we just produce a value during parsing and just consume a value during pretty-printing.
40− To support this style we define a functor and applicative structure on @cat () b@, for example
41− '/*/' (equivalent of '<*>') has type @(\/*\/) :: SIArrow cat => cat () a -> cat () b -> cat () (a, b)@.
42− .
43− When more power then applicative is needed - for example when the syntax depends on the
44− parsed value - we turn back to arrow composition.
45− .
46− Module "Control.Category.Reader" defines a Reader category transformer. It is like a monad
47− transformer, but for categories. The next version will include some more transformers and
48− mtl-style classes.
49−license: MIT
50−license-file: LICENSE
51−author: Paweł Nowak
52−maintainer: Paweł Nowak <pawel834@gmail.com>
53−copyright: Paweł Nowak 2014
54−category: Control, Data
55−build-type: Simple
56−cabal-version: >=1.11
57−Tested-with: GHC==8.0.2, GHC==8.2.2, GHC==8.4.3, GHC==8.6.1
58−
59−source-repository head
60− type: git
61− location: git@github.com:Pawel834/semi-iso.git
62−
63−library
64− exposed-modules: Control.Lens.SemiIso
65− Control.Lens.Internal.SemiIso
66− Control.SIArrow
67− Control.Category.Reader
68− Control.Category.Structures
69− Data.Profunctor.Exposed
70− Control.Tuple.Morph
71− build-depends: base >= 4.9 && <4.13
72− , profunctors == 5.*
73− , transformers
74− , lens == 4.*
75− , semigroupoids
76− default-language: Haskell2010
77− ghc-options: -Wall
Control/Category/Reader.hs → src/Control/Category/Reader.hsrenamed+9−5
@@ -15,6 +15,7 @@ module Control.Category.Reader (
1515 ReaderCT(..)
1616 ) where
1717
18+import Control.Arrow
1819import Control.Category
1920import Control.Category.Structures
2021import Control.Lens.Iso
@@ -31,15 +32,18 @@ instance Category cat => Category (ReaderCT env cat) where
3132 id = clift id
3233 ReaderCT f . ReaderCT g = ReaderCT $ \x -> f x . g x
3334
34−instance Products cat => Products (ReaderCT env cat) where
35+instance Arrow cat => Arrow (ReaderCT env cat) where
36+ arr f = ReaderCT $ \_ -> arr f
3537 ReaderCT f *** ReaderCT g = ReaderCT $ \x -> f x *** g x
3638
37−instance Coproducts cat => Coproducts (ReaderCT env cat) where
39+instance ArrowChoice cat => ArrowChoice (ReaderCT env cat) where
3840 ReaderCT f +++ ReaderCT g = ReaderCT $ \x -> f x +++ g x
3941
40−instance CatPlus cat => CatPlus (ReaderCT env cat) where
41− cempty = clift cempty
42− ReaderCT f /+/ ReaderCT g = ReaderCT $ \x -> f x /+/ g x
42+instance ArrowZero cat => ArrowZero (ReaderCT env cat) where
43+ zeroArrow = clift zeroArrow
44+
45+instance ArrowPlus cat => ArrowPlus (ReaderCT env cat) where
46+ ReaderCT f <+> ReaderCT g = ReaderCT $ \x -> f x <+> g x
4347
4448instance SIArrow cat => SIArrow (ReaderCT env cat) where
4549 siarr = clift . siarr
src/Control/Category/Structures.hsnew file+31
@@ -0,0 +1,31 @@
1+{-# LANGUAGE TypeFamilies #-}
2+{-# LANGUAGE FlexibleInstances #-}
3+{-# LANGUAGE ConstraintKinds #-}
4+{- |
5+Module : Control.Category.Structures
6+Description : Structures in a category.
7+Copyright : (c) Paweł Nowak
8+License : MIT
9+
10+Maintainer : Paweł Nowak <pawel834@gmail.com>
11+Stability : experimental
12+
13+This module defines some basic structures in a category in a more fine-grained
14+way then "Control.Arrow".
15+
16+Unfortunately names in this module clash with "Control.Arrow".
17+-}
18+module Control.Category.Structures
19+ ( CatTrans(..)
20+ ) where
21+
22+import Control.Category
23+import Prelude hiding (id, (.))
24+
25+
26+-- | A category transformer.
27+class CatTrans t where
28+ -- | Lift an arrow from the base category.
29+ clift :: Category cat => cat a b -> t cat a b
30+
31+ {-# MINIMAL clift #-}
Control/Lens/Internal/SemiIso.hs → src/Control/Lens/Internal/SemiIso.hsrenamed+5−3
@@ -9,7 +9,9 @@ License : MIT
99Maintainer : Paweł Nowak <pawel834@gmail.com>
1010Stability : experimental
1111-}
12−module Control.Lens.Internal.SemiIso where
12+module Control.Lens.Internal.SemiIso
13+ ( Retail(..)
14+ ) where
1315
1416import Control.Monad
1517import Data.Profunctor
@@ -25,9 +27,9 @@ instance Profunctor (Retail s t) where
2527 rmap f (Retail l r) = Retail l (fmap f . r)
2628
2729instance Choice (Retail s t) where
28− left' (Retail as st) = Retail
30+ left' (Retail as st) = Retail
2931 (either as (\_ -> Left "semi-iso failed")) (fmap Left . st)
30− right' (Retail as st) = Retail
32+ right' (Retail as st) = Retail
3133 (either (\_ -> Left "semi-iso failed") as) (fmap Right . st)
3234
3335-- Proof of 'Exposed' laws:
Control/Lens/SemiIso.hs → src/Control/Lens/SemiIso.hsrenamed+18−11
@@ -4,6 +4,8 @@
44{-# LANGUAGE ViewPatterns #-}
55{-# LANGUAGE PatternSynonyms #-}
66{-# LANGUAGE FlexibleContexts #-}
7+
8+{-# OPTIONS_GHC -Wno-incomplete-patterns #-}
79{- |
810Module : Control.Lens.SemiIso
911Description : Semi-isomorphisms.
@@ -98,9 +100,8 @@ module Control.Lens.SemiIso (
98100 bifoldl1_
99101 ) where
100102
101−import Control.Arrow (Kleisli(..))
103+import Control.Arrow
102104import Control.Category
103−import Control.Category.Structures
104105import Control.Lens.Internal.SemiIso
105106import Control.Lens.Iso
106107import Control.Tuple.Morph
@@ -133,6 +134,10 @@ type ASemiIso' s a = ASemiIso s s a a
133134
134135-- | A nice pattern synonym for SemiIso's. Gives you the two functions, just like
135136-- 'viewSemiIso' or 'fromSemiIso'.
137+pattern SemiIso
138+ :: (s -> Either String a)
139+ -> (b -> Either String t)
140+ -> ASemiIso s t a b
136141pattern SemiIso sa bt <- (viewSemiIso -> (sa, bt))
137142
138143-- | A semi-iso stored in a container.
@@ -142,7 +147,8 @@ instance Category ReifiedSemiIso' where
142147 id = ReifiedSemiIso' id
143148 ReifiedSemiIso' f . ReifiedSemiIso' g = ReifiedSemiIso' (g . f)
144149
145−instance Products ReifiedSemiIso' where
150+instance Arrow ReifiedSemiIso' where
151+ arr f = ReifiedSemiIso' $ semiIso (Right . f) (const $ Left "oh no")
146152 -- TODO: pattern synonyms dont work here for some reason
147153 first (ReifiedSemiIso' ai) = withSemiIso ai $ \f g ->
148154 ReifiedSemiIso' $ cloneSemiIso $
@@ -159,7 +165,7 @@ instance Products ReifiedSemiIso' where
159165 semiIso (runKleisli $ Kleisli f *** Kleisli f')
160166 (runKleisli $ Kleisli g *** Kleisli g')
161167
162−instance Coproducts ReifiedSemiIso' where
168+instance ArrowChoice ReifiedSemiIso' where
163169 left (ReifiedSemiIso' ai) = withSemiIso ai $ \f g ->
164170 ReifiedSemiIso' $ cloneSemiIso $
165171 semiIso (runKleisli $ left $ Kleisli f)
@@ -175,18 +181,19 @@ instance Coproducts ReifiedSemiIso' where
175181 semiIso (runKleisli $ Kleisli f +++ Kleisli f')
176182 (runKleisli $ Kleisli g +++ Kleisli g')
177183
178−instance CatPlus ReifiedSemiIso' where
179− cempty = ReifiedSemiIso' $ alwaysFailing "cempty"
184+instance ArrowZero ReifiedSemiIso' where
185+ zeroArrow = ReifiedSemiIso' $ alwaysFailing "zeroArrow"
180186
181− ReifiedSemiIso' ai /+/ ReifiedSemiIso' ai' = ReifiedSemiIso' $
187+instance ArrowPlus ReifiedSemiIso' where
188+ ReifiedSemiIso' ai <+> ReifiedSemiIso' ai' = ReifiedSemiIso' $
182189 withSemiIso ai $ \f g -> withSemiIso ai' $ \f' g' ->
183− semiIso (runKleisli $ Kleisli f /+/ Kleisli f')
184− (runKleisli $ Kleisli g /+/ Kleisli g')
190+ semiIso (runKleisli $ Kleisli f <+> Kleisli f')
191+ (runKleisli $ Kleisli g <+> Kleisli g')
185192
186193-- | Constructs a semi isomorphism from a pair of functions that can
187194-- fail with an error message.
188195semiIso :: (s -> Either String a) -> (b -> Either String t) -> SemiIso s t a b
189−semiIso sa bt = merge . dimap sa (sequenceA . fmap bt) . expose
196+semiIso sa bt = merge . dimap sa (traverse bt) . expose
190197
191198-- | Clones a semi-iso.
192199cloneSemiIso :: ASemiIso s t a b -> SemiIso s t a b
@@ -301,7 +308,7 @@ elimFirst ai = swapped . elimSecond ai
301308-- | Uses an @SemiIso b ()@ to construct a @SemiIso (a, b) a@,
302309-- i.e. eliminates the second pair element.
303310elimSecond :: ASemiIso' s () -> SemiIso' (t, s) t
304−elimSecond ai = runSemiIso (id *** reifySemiIso ai) . rev unit
311+elimSecond ai = runSemiIso (second $ reifySemiIso ai) . rev unit
305312
306313-- | Transforms the semi-iso so that applying it in both directions never fails,
307314-- but instead catches any errors and returns them as an @Either String a@.
Control/SIArrow.hs → src/Control/SIArrow.hsrenamed+7−29
@@ -33,20 +33,18 @@ module Control.SIArrow (
3333 sireplicate_
3434 ) where
3535
36−import Control.Arrow (Kleisli(..))
36+import Control.Arrow
3737import Control.Category
38−import Control.Category.Structures
3938import Control.Lens.Cons
4039import Control.Lens.Empty
4140import Control.Lens.Iso
4241import Control.Lens.SemiIso
4342import Control.Monad
4443import Control.Tuple.Morph
45−import Data.Semigroupoid.Dual
4644import Prelude hiding (id, (.))
4745
48−infixr 1 ^>>, ^<<, #>>, #<<
49−infixr 1 >>^, <<^, >>#, <<#
46+infixr 1 #>>, #<<
47+infixr 1 >>#, <<#
5048infixl 4 /$/, /$~
5149infixl 5 /*/, */, /*
5250infixl 3 /?/
@@ -59,7 +57,7 @@ infixl 3 /?/
5957--
6058-- The category @cat@ should contain @SemiIso@ as a sort of
6159-- \"subcategory of pure computations\".
62−class (Products cat, Coproducts cat, CatPlus cat) => SIArrow cat where
60+class (Arrow cat, ArrowChoice cat, ArrowPlus cat) => SIArrow cat where
6361 -- | Allows you to lift a SemiIso into @cat@. The resulting arrow should be
6462 -- in some sense minimal or \"pure\", similiar to 'pure', 'return' and
6563 -- 'arr' from "Control.Category".
@@ -87,7 +85,7 @@ class (Products cat, Coproducts cat, CatPlus cat) => SIArrow cat where
8785
8886 -- | @simany v@ repeats @v@ as long as possible.
8987 simany :: cat () b -> cat () [b]
90− simany v = sisome v /+/ sipure _Empty
88+ simany v = sisome v <+> sipure _Empty
9189
9290 {-# MINIMAL (siarr | sipure), sibind #-}
9391
@@ -95,32 +93,12 @@ instance MonadPlus m => SIArrow (Kleisli m) where
9593 siarr ai = Kleisli $ either fail return . apply ai
9694 sibind ai = Kleisli $ \a -> either fail (($ a) . runKleisli) $ apply ai a
9795
98−instance SIArrow cat => SIArrow (Dual cat) where
99− siarr = Dual . sipure
100− sibind ai = Dual $ sibind (iso id getDual . rev ai . iso getDual id)
101−
10296instance SIArrow ReifiedSemiIso' where
10397 siarr = reifySemiIso
10498 sibind ai = ReifiedSemiIso' $
10599 semiIso (\a -> apply ai a >>= flip apply a . runSemiIso)
106100 (\b -> unapply ai b >>= flip unapply b . runSemiIso)
107101
108−-- | Composes a SemiIso with an arrow.
109−(^>>) :: SIArrow cat => ASemiIso' a b -> cat b c -> cat a c
110−f ^>> a = a . siarr f
111−
112−-- | Composes an arrow with a SemiIso.
113−(>>^) :: SIArrow cat => cat a b -> ASemiIso' b c -> cat a c
114−a >>^ f = siarr f . a
115−
116−-- | Composes a SemiIso with an arrow, backwards.
117−(^<<) :: SIArrow cat => ASemiIso' b c -> cat a b -> cat a c
118−f ^<< a = siarr f . a
119−
120−-- | Composes an arrow with a SemiIso, backwards.
121−(<<^) :: SIArrow cat => cat b c -> ASemiIso' a b -> cat a c
122−a <<^ f = a . siarr f
123−
124102-- | Composes a reversed SemiIso with an arrow.
125103(#>>) :: SIArrow cat => ASemiIso' b a -> cat b c -> cat a c
126104f #>> a = a . sipure f
@@ -171,7 +149,7 @@ ai /$<~> h = cloneSemiIso ai . reorderMorphed /$/ h
171149--
172150-- The uncurried analogue of '<*>'.
173151(/*/) :: SIArrow cat => cat () b -> cat () c -> cat () (b, c)
174−a /*/ b = unit ^>> (a *** b)
152+a /*/ b = siarr unit >>> (a *** b)
175153
176154-- | The product of two arrows, where the second one has no input and no output
177155-- (but can have side effects), with duplicate units removed. Side effect are
@@ -195,7 +173,7 @@ sifail = siarr . alwaysFailing
195173
196174-- | Provides an error message in the case of failure.
197175(/?/) :: SIArrow cat => cat a b -> String -> cat a b
198−f /?/ msg = f /+/ sifail msg
176+f /?/ msg = f <+> sifail msg
199177
200178-- | Equivalent of 'sequence'.
201179sisequence :: SIArrow cat => [cat () a] -> cat () [a]
Control/Tuple/Morph.hs → src/Control/Tuple/Morph.hsrenamed+1−1
@@ -16,7 +16,7 @@
1616 FlexibleContexts
1717 #-}
1818
19−{-# OPTIONS_GHC -Wno-incomplete-patterns #-}
19+{-# OPTIONS_GHC -Wno-incomplete-patterns -Wno-redundant-constraints #-}
2020
2121module Control.Tuple.Morph
2222 ( morphTuples
Data/Profunctor/Exposed.hs → src/Data/Profunctor/Exposed.hsrenamed+7−5
@@ -1,5 +1,5 @@
11{-# LANGUAGE FunctionalDependencies #-}
2−{-# LANGUAGE MultiParamTypeClasses #-}
2+
33{- |
44Module : Data.Profunctor.Exposed
55Description : Exposes Kleisli category structure beneath a profunctor.
@@ -9,18 +9,20 @@ License : MIT
99Maintainer : Paweł Nowak <pawel834@gmail.com>
1010Stability : experimental
1111-}
12−module Data.Profunctor.Exposed where
12+module Data.Profunctor.Exposed
13+ ( Exposed(..)
14+ ) where
1315
1416import Data.Profunctor
1517
1618-- | Exposes structure of a Kleisli category beneath a profunctor.
17−--
19+--
1820-- Should obey laws:
19−--
21+--
2022-- prop> merge . rmap return = id
2123-- prop> lmap return . expose = id
2224-- prop> rmap (>>= f) = merge . rmap (fmap f)
2325-- prop> lmap (fmap f) . expose = expose . lmap f
2426class (Monad m, Profunctor p) => Exposed m p | p -> m where
2527 expose :: p a b -> p (m a) b
26− merge :: p a (m b) -> p a b
28+ merge :: p a (m b) -> p a b
stack.yamlnew file+69
@@ -0,0 +1,69 @@
1+# This file was automatically generated by 'stack init'
2+#
3+# Some commonly used options have been documented as comments in this file.
4+# For advanced use and comprehensive documentation of the format, please see:
5+# https://docs.haskellstack.org/en/stable/yaml_configuration/
6+
7+# Resolver to choose a 'specific' stackage snapshot or a compiler version.
8+# A snapshot resolver dictates the compiler version and the set of packages
9+# to be used for project dependencies. For example:
10+#
11+# resolver: lts-3.5
12+# resolver: nightly-2015-09-21
13+# resolver: ghc-7.10.2
14+#
15+# The location of a snapshot can be provided as a file or url. Stack assumes
16+# a snapshot provided as a file might change, whereas a url resource does not.
17+#
18+# resolver: ./custom-snapshot.yaml
19+# resolver: https://example.com/snapshots/2018-01-01.yaml
20+resolver: lts-14.6
21+
22+# User packages to be built.
23+# Various formats can be used as shown in the example below.
24+#
25+# packages:
26+# - some-directory
27+# - https://example.com/foo/bar/baz-0.0.2.tar.gz
28+# subdirs:
29+# - auto-update
30+# - wai
31+packages:
32+- .
33+# Dependency packages to be pulled from upstream that are not in the resolver.
34+# These entries can reference officially published versions as well as
35+# forks / in-progress versions pinned to a git hash. For example:
36+#
37+# extra-deps:
38+# - acme-missiles-0.3
39+# - git: https://github.com/commercialhaskell/stack.git
40+# commit: e7b331f14bcffb8367cd58fbfc8b40ec7642100a
41+#
42+# extra-deps: []
43+
44+# Override default flag values for local packages and extra-deps
45+# flags: {}
46+
47+# Extra package databases containing global packages
48+# extra-package-dbs: []
49+
50+# Control whether we use the GHC we find on the path
51+# system-ghc: true
52+#
53+# Require a specific version of stack, using version ranges
54+# require-stack-version: -any # Default
55+# require-stack-version: ">=2.1"
56+#
57+# Override the architecture used by stack, especially useful on Windows
58+# arch: i386
59+# arch: x86_64
60+#
61+# Extra directories used by stack for building
62+# extra-include-dirs: [/path/to/dir]
63+# extra-lib-dirs: [/path/to/dir]
64+#
65+# Allow a newer minor version of GHC than the snapshot specifies
66+# compiler-check: newer-minor
67+
68+ghc-options:
69+ "$locals": -ddump-to-file -ddump-hi -fwarn-unused-binds -fwarn-unused-imports