<div dir="ltr">Any function with type `State s ()` is essentially `s -> s`. So you'd really have:<div><br></div><div>    modifyR :: R -> Maybe R</div><div>    modifyR = ...<br><br>Alternatively, you can push the requirement down into the `_int` field by making the type `Even Int` for a newtype `Even` with relevant safe operations. Then, your function looks like:<br><br>    modifyR :: (Even Int -> Maybe (Even Int)) -> R -> Maybe R<br><br>Which looks an awful lot like a `Traversal`:</div><div><br></div><div>    type Traversal s t a b = forall f. Applicative f => (a -> f b) -> s -> f t</div><div>    type Traversal' s a = Traversal s s a a<br>    modifyR :: Traversal (Even Int) R</div><div><br></div><div><br></div></div><div class="gmail_extra"><br clear="all"><div><div class="gmail_signature" data-smartmail="gmail_signature"><div dir="ltr"><div>Matt Parsons</div></div></div></div>
<br><div class="gmail_quote">On Sat, Dec 23, 2017 at 2:21 PM, Evan Laforge <span dir="ltr"><<a href="mailto:qdunkan@gmail.com" target="_blank">qdunkan@gmail.com</a>></span> wrote:<br><blockquote class="gmail_quote" style="margin:0 0 0 .8ex;border-left:1px #ccc solid;padding-left:1ex">Here's another semi-derail: how can you do get/set with side-effects?<br>
This would necessarily be for a record in StateM or something.  For<br>
instance, say to preserve an invariant on a field:<br>
<br>
    import qualified Control.Monad.State as State<br>
<br>
    data R { _int :: Int }<br>
<br>
    modifyInt :: (R -> R) -> State.State R ()<br>
    modifyInt modify = do<br>
        int <- modify <$> State.gets _int<br>
        if even int then State.modify \r -> r { _int = int }<br>
            else Except.throwError "odd"<br>
<br>
I couldn't figure out how to get this sort of thing to cooperate with<br>
lenses.  I can make a lens with effects easily enough, but you have to<br>
invoke it via 'State.modify $ ...', at which point you're exposing<br>
State.modify which defeats the idea of trying to enforce invariants.<br>
<div class="HOEnZb"><div class="h5"><br>
On Sat, Dec 23, 2017 at 12:31 PM, Tikhon Jelvis <<a href="mailto:tikhon@jelv.is">tikhon@jelv.is</a>> wrote:<br>
> Yes, that is a good summary. Typeclass instances are inherently not modular.<br>
> There are some tradeoffs to this design—if you want to see an alternative,<br>
> take a look at how Scala deals with implicits.<br>
><br>
> On Sat, Dec 23, 2017 at 12:21 PM, Siddharth Bhat <<a href="mailto:siddu.druid@gmail.com">siddu.druid@gmail.com</a>><br>
> wrote:<br>
>><br>
>> Ah, thank you! I was unaware of the  "OverloadedLabels" extension.<br>
>><br>
>> So, orphan instances are an anti-pattern because their scope is hard to<br>
>> control? As in, when we import a module, we cannot "choose" to import<br>
>> typeclass definitions on types, right?<br>
>><br>
>> Thanks,<br>
>> Siddharth<br>
>><br>
>><br>
>> On Sun 24 Dec, 2017, 01:46 Tikhon Jelvis, <<a href="mailto:tikhon@jelv.is">tikhon@jelv.is</a>> wrote:<br>
>>><br>
>>> Please don't worry about derailing—if you had the question, I'm sure a<br>
>>> lot of other people reading did as well.<br>
>>><br>
>>> An "orphan instance" is a typeclass instance defined in a module that<br>
>>> doesn't also define the class or the type. In my example, it's an instance<br>
>>> of the IsLabel class (from GHC.OverloadedLabels) for the function type (a -><br>
>>> b). This is a problem because Haskell typeclass instances are not module—a<br>
>>> type can only have one instance of a given class *in the entire program*.<br>
>>> This means that if two libraries defined the instance I gave, *you would not<br>
>>> be able to use them together in the same project*. This is why you should<br>
>>> absolutely not define this instance in a library.<br>
>>><br>
>>> An alternative design here would be to define a new type for lenses that<br>
>>> does not overlap with (a -> b). Something like ReifiedLens, defined<br>
>>> specifically to have this instance:<br>
>>><br>
>>> newtype FieldLens s t a b = FieldLens (Lens s t a b)<br>
>>><br>
>>> instance (...) => IsLabel (FieldLens s t a b) where<br>
>>>   ...<br>
>>><br>
>>> Unfortunately, this would make FieldLens incompatible with normal lenses,<br>
>>> leading to a bit of boilerplate each time you had to call a field.<br>
>>><br>
>>> The other alternative is to use RebindableSyntax which lets you<br>
>>> substitute your own IsLabel class in place of the one defined in<br>
>>> GHC.OverloadedLabels. This is probably the neatest solution, but<br>
>>> RebindableSyntax feels like a really heavyweight extension to use. That<br>
>>> said, my guess is that we'll use it in our internal code at work if there is<br>
>>> ever a conflict with the current IsLabel instance we're using. The current<br>
>>> experience with records is too nice to pass up without a fight :).<br>
>>><br>
>>> The #bar syntax uses the OverloadedLabels extension. This adds the<br>
>>> IsLabel class and desugars #bar into fromLabel @"bar"<br>
>>><br>
>>> The @ is type application, so the "bar" in fromLabel @"bar" is a<br>
>>> type-level symbol, not a normal string. This is how we get the name of the<br>
>>> field into the typeclass instance.<br>
>>><br>
>>><br>
>>><br>
>>> On Sat, Dec 23, 2017 at 12:01 PM, Siddharth Bhat <<a href="mailto:siddu.druid@gmail.com">siddu.druid@gmail.com</a>><br>
>>> wrote:<br>
>>>><br>
>>>> At the risk of derailing the thread, what exactly does it mean to be an<br>
>>>> "orphan instance"? And where does "#bar" come from, I've never seen that<br>
>>>> syntax before :) I followed the exposition up to that point, if it helps.<br>
>>>><br>
>>>> Thanks,<br>
>>>> Siddharth<br>
>>>><br>
>>>><br>
>>>> On Sun 24 Dec, 2017, 01:23 Tikhon Jelvis, <<a href="mailto:tikhon@jelv.is">tikhon@jelv.is</a>> wrote:<br>
>>>>><br>
>>>>> This is a real pain point with records in Haskell.<br>
>>>>><br>
>>>>> The fundamental problem is that unlike most languages with records or<br>
>>>>> object, field names are treated as normal identifiers in Haskell. Other<br>
>>>>> languages make fields special—you can only use them with the . operator or<br>
>>>>> in other select contexts. The advantage is that you can do things like<br>
>>>>> `a.author == author`; the disadvantage is that fields become a second-class<br>
>>>>> citizen.<br>
>>>>><br>
>>>>> At work, we have a solution that's really nice to use built on top of<br>
>>>>> DuplicateRecordFields and OverloadedLabels. Our approach follows the ideas<br>
>>>>> in the OverloadedRecordFields proposal but with a lens flavor—very similar<br>
>>>>> to the overloaded-records[1] package. (We don't use that package directly<br>
>>>>> because I wrote our own version before I knew about it and I like the<br>
>>>>> ergonomics of our internal version a bit more.)<br>
>>>>><br>
>>>>> We have a couple of typeclasses for reading and writing fields:<br>
>>>>><br>
>>>>> class HasField (field :: Symbol) s a | s -> a where<br>
>>>>>   getField :: s -> a<br>
>>>>><br>
>>>>> class UpdatesField (field :: Symbol) s t b | name t -> b, name s b -> t<br>
>>>>> where<br>
>>>>>   updateField :: s -> b -> t<br>
>>>>><br>
>>>>> A record field can be both read and updated:<br>
>>>>><br>
>>>>> type Field field s t a b = (HasField field s a, UpdatesField field name<br>
>>>>> s t b)<br>
>>>>><br>
>>>>> field :: forall (name :: Symbol) s t a b. Field name s t a b => Lens s<br>
>>>>> t a b<br>
>>>>> field = lens (getField @name) (updateField @name)<br>
>>>>><br>
>>>>> Then we have some Template Haskell for generating instances of these<br>
>>>>> classes. Here's a contrived example:<br>
>>>>><br>
>>>>> data Foo a = Foo { bar :: [a] }<br>
>>>>><br>
>>>>> record ''Foo<br>
>>>>><br>
>>>>> which generates:<br>
>>>>><br>
>>>>> instance HasField "bar" (Foo a) a where<br>
>>>>>   getField = bar<br>
>>>>><br>
>>>>> instance UpdatesField "bar" (Foo a) (Foo b) b where<br>
>>>>>   updateField foo bar' = foo { bar = bar' }<br>
>>>>><br>
>>>>> Given these, we can already write code looking up fields as lenses:<br>
>>>>><br>
>>>>> > Foo [1,2,3] ^. field @"bar"<br>
>>>>> [1,2,3]<br>
>>>>><br>
>>>>> Now fields aren't normal identifiers any more, the names can be shared<br>
>>>>> over different records (with DuplicateRecordFields) and you can write<br>
>>>>> functions polymorphic over any record with a given field.<br>
>>>>><br>
>>>>> The names and details here are a bit different, but I believe this is<br>
>>>>> otherwise exactly what overloaded-records gives you. You could also replace<br>
>>>>> the TH to generate instances with generics in the style of the generic-lens<br>
>>>>> library.<br>
>>>>><br>
>>>>> However, the field @"bar" is painfully verbose. We solve this using<br>
>>>>> OverloadedLabels and a somewhat shady orphan instance for IsLabel:<br>
>>>>><br>
>>>>> instance (Functor f, Field name s t a b, a' ~ (a -> f b), b' ~ (s -> f<br>
>>>>> t)) => IsLabel name (a' -> b') where<br>
>>>>>   fromLabel = field @name<br>
>>>>><br>
>>>>> The details are a bit fiddly, but this is what we need to make type<br>
>>>>> inference work correctly. This lets us replace field @"name" with #name:<br>
>>>>><br>
>>>>> > Foo [1,2,3] ^. #bar<br>
>>>>> [1,2,3]<br>
>>>>> > Foo [1,2,3] & #bar . each %~ show<br>
>>>>> Foo { bar = ["1","2","3"] }<br>
>>>>><br>
>>>>> The downside is that this is an orphan instance for IsLabel for *all<br>
>>>>> functions*. You would not want to use this in a library but it's fine in an<br>
>>>>> executable as long as you don't mind potentially needing to reword things if<br>
>>>>> a similar IsLabel instance is added to base. (A risk I'm willing to take for<br>
>>>>> better syntax :))<br>
>>>>><br>
>>>>> Apart from that (somewhat serious) downside, the final result is pretty<br>
>>>>> much perfect: fields are first-class citizens (as lenses) and are not in the<br>
>>>>> same scope as identifiers. We've been using this extensively throughout our<br>
>>>>> whole project and it's been perfect—perhaps surprisingly, we haven't run<br>
>>>>> into any issues with type inference or type error messages (beyond what you<br>
>>>>> normally get with lens).<br>
>>>>><br>
>>>>> With this addition, Haskell records went from being a real blemish on<br>
>>>>> the language to being the best I've ever used. The orphan instance is a<br>
>>>>> definite red flag and you should absolutely *not* have that instance in a<br>
>>>>> library, but if you're working on a standalone executable or some extensive<br>
>>>>> internal code, I think it's absolutely worth it.<br>
>>>>><br>
>>>>> [1]: <a href="https://hackage.haskell.org/package/overloaded-records" rel="noreferrer" target="_blank">https://hackage.haskell.org/<wbr>package/overloaded-records</a><br>
>>>>><br>
>>>>> [2]: <a href="https://hackage.haskell.org/package/generic-lens" rel="noreferrer" target="_blank">https://hackage.haskell.org/<wbr>package/generic-lens</a><br>
>>>>><br>
>>>>><br>
>>>>> On Sat, Dec 23, 2017 at 6:41 AM, Li-yao Xia <<a href="mailto:lysxia@gmail.com">lysxia@gmail.com</a>> wrote:<br>
>>>>>><br>
>>>>>> I don't think "authorL" hurts readability. It just seems the logical<br>
>>>>>> choice if "author" is already taken.<br>
>>>>>><br>
>>>>>> Have you seen generic-lens? The lens for the "author" field is  (field<br>
>>>>>> @"author") so there is some added noise compared to "authorL", but it can be<br>
>>>>>> used as a TH-free alternative to makeClassy.<br>
>>>>>><br>
>>>>>> type Field name a = forall s. HasField name s s a a => Lens s s a a<br>
>>>>>><br>
>>>>>> authorL :: Field "author" Author<br>
>>>>>> authorL = field @"author"<br>
>>>>>><br>
>>>>>> Cheers,<br>
>>>>>> Li-yao<br>
>>>>>><br>
>>>>>><br>
>>>>>> On 12/23/2017 08:36 AM, ☂Josh Chia (謝任中) wrote:<br>
>>>>>>><br>
>>>>>>> Quite often, I need to use record types like this:<br>
>>>>>>><br>
>>>>>>> data Whole1 = Whole1 { part :: Part, ... }<br>
>>>>>>> data Whole2 = Whole2 { part :: Part, ... }<br>
>>>>>>><br>
>>>>>>> Where Whole1 & Whole2 are types of things that have a Part and some<br>
>>>>>>> other things. E.g. a Book has an Author, a Title, etc and so does an<br>
>>>>>>> Article.<br>
>>>>>>><br>
>>>>>>> The problem is that I'm not actually allowed to use the same name<br>
>>>>>>> (author/part) in two different record types. Some people use lens to solve<br>
>>>>>>> this. You can have a lens called 'author' for dealing with the Author in<br>
>>>>>>> both Book and Article (e.g. using makeClassy).<br>
>>>>>>><br>
>>>>>>> That's fine, but there's yet another problem. Let's say I have a<br>
>>>>>>> function that takes an Author and a [Library] and returns all the Libraries<br>
>>>>>>> that have Books or Articles matching the Author. So:<br>
>>>>>>><br>
>>>>>>> findAuthorLibraries :: Author -> [Library] -> [Library]<br>
>>>>>>> findAuthorLibraries author libraries = ...<br>
>>>>>>><br>
>>>>>>> But I already have a lens called 'author' and ghc will complain about<br>
>>>>>>> shadowing. So, to avoid shadowing, should I use 'theAuthor' instead of<br>
>>>>>>> 'author' for the function argument? Or, should I name the lens 'authorLens',<br>
>>>>>>> 'authorL' or 'lAuthor' instead of 'author'? Prefixing with 'the' is quite<br>
>>>>>>> unreadable because whether or not an argument has that prefix depends on<br>
>>>>>>> whether there's a lens with a conflicting name so it adds noise to the code.<br>
>>>>>>> Adding a 'Lens' prefix to the 'author' lens also seems quite an overbearing<br>
>>>>>>> eyesore because for consistency I would have to use the prefix for all my<br>
>>>>>>> field-accessing lenses.<br>
>>>>>>><br>
>>>>>>> Maybe I should use Lens.Control.TH.makeClassy and then define:<br>
>>>>>>><br>
>>>>>>> findAuthorLibraries :: HasAuthor a => a -> [Library] -> [Library]<br>
>>>>>>> findAuthorLibraries hasAuthor libraries = ...<br>
>>>>>>><br>
>>>>>>> But that may be making my function more complicated and general than<br>
>>>>>>> I want, affecting readability, simplicity, compilation time and maybe even<br>
>>>>>>> performance.<br>
>>>>>>><br>
>>>>>>> In summary, I find that there are ways around the problem but they<br>
>>>>>>> really affect readability.<br>
>>>>>>><br>
>>>>>>> I could also disable the warning about shadowing but that seems<br>
>>>>>>> pretty dangerous. It may be OK to disable the warning for the specific cases<br>
>>>>>>> where a function argument shadows something from the topmost scope, but GHC<br>
>>>>>>> does not allow such selective disabling of that warning.<br>
>>>>>>><br>
>>>>>>> In a code base that deals mainly with concrete business logic, this<br>
>>>>>>> problem probably crops up more than in a code base that deals mainly with<br>
>>>>>>> more abstract things.<br>
>>>>>>><br>
>>>>>>> What do people do to address this problem? Any recommendations or<br>
>>>>>>> best practices?<br>
>>>>>>><br>
>>>>>>> Josh<br>
>>>>>>><br>
>>>>>>><br>
>>>>>>> ______________________________<wbr>_________________<br>
>>>>>>> Haskell-Cafe mailing list<br>
>>>>>>> To (un)subscribe, modify options or view archives go to:<br>
>>>>>>> <a href="http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe" rel="noreferrer" target="_blank">http://mail.haskell.org/cgi-<wbr>bin/mailman/listinfo/haskell-<wbr>cafe</a><br>
>>>>>>> Only members subscribed via the mailman list are allowed to post.<br>
>>>>>>><br>
>>>>>> ______________________________<wbr>_________________<br>
>>>>>> Haskell-Cafe mailing list<br>
>>>>>> To (un)subscribe, modify options or view archives go to:<br>
>>>>>> <a href="http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe" rel="noreferrer" target="_blank">http://mail.haskell.org/cgi-<wbr>bin/mailman/listinfo/haskell-<wbr>cafe</a><br>
>>>>>> Only members subscribed via the mailman list are allowed to post.<br>
>>>>><br>
>>>>><br>
>>>>> ______________________________<wbr>_________________<br>
>>>>> Haskell-Cafe mailing list<br>
>>>>> To (un)subscribe, modify options or view archives go to:<br>
>>>>> <a href="http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe" rel="noreferrer" target="_blank">http://mail.haskell.org/cgi-<wbr>bin/mailman/listinfo/haskell-<wbr>cafe</a><br>
>>>>> Only members subscribed via the mailman list are allowed to post.<br>
>>>><br>
>>>> --<br>
>>>> Sending this from my phone, please excuse any typos!<br>
>>><br>
>>><br>
>> --<br>
>> Sending this from my phone, please excuse any typos!<br>
><br>
><br>
><br>
> ______________________________<wbr>_________________<br>
> Haskell-Cafe mailing list<br>
> To (un)subscribe, modify options or view archives go to:<br>
> <a href="http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe" rel="noreferrer" target="_blank">http://mail.haskell.org/cgi-<wbr>bin/mailman/listinfo/haskell-<wbr>cafe</a><br>
> Only members subscribed via the mailman list are allowed to post.<br>
______________________________<wbr>_________________<br>
Haskell-Cafe mailing list<br>
To (un)subscribe, modify options or view archives go to:<br>
<a href="http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe" rel="noreferrer" target="_blank">http://mail.haskell.org/cgi-<wbr>bin/mailman/listinfo/haskell-<wbr>cafe</a><br>
Only members subscribed via the mailman list are allowed to post.</div></div></blockquote></div><br></div>