如何为求和类型写镜头

时间:2018-10-16 09:49:20

标签: haskell lens

我有这样的类型:

    StorageReference storageReference = storage.getReference();
                storageReference.child("profileImageUrl").child(userID).putFile(resultUri)
                        .addOnSuccessListener(new OnSuccessListener<UploadTask.TaskSnapshot>() {
                            @Override
                            public void onSuccess(UploadTask.TaskSnapshot taskSnapshot) {

                                String url = taskSnapshot.getDownloadUrl().toString();
                                mCustomerDatabase1.child("profileImageUrl").setValue(url).addOnCompleteListener(new OnCompleteListener<Void>() {
                                    @Override
                                    public void onComplete(@NonNull Task<Void> task) {


                                        if (task.isSuccessful()){
                                    Toast.makeText(getApplicationContext(),"File Successfully Uploaded",LENGTH_SHORT).show();
 }
                                        else{

                                            Toast.makeText(getApplicationContext(),"File not Successfully Uploaded",LENGTH_SHORT).show(); }
                                    }
                                });
                            }
                        }).addOnFailureListener(new OnFailureListener() {
                    @Override
                    public void onFailure(@NonNull Exception e) {

                        Toast.makeText(getApplicationContext(),"File not Successfully Uploaded",LENGTH_SHORT).show();

                    }
                });

$(document).ready(function(){ showMessage(); setInterval(function(){ $(".msg-content").empty(); showMessage(); }, 8000); }) function showMessage() { for (var i = 1; i < 4; i++) { $(".msg-content").append('<div id="msg' + i + '" class="msg-receive dib mb4 bg-message br4 pv2 ph3 white measure-narrow">"Message ' + i + '"</div>'); } } data Problem = ProblemFoo Foo | ProblemBar Bar | ProblemBaz Baz Foo的名字都有其代表:

Bar

现在我想创建一个镜头

Baz

很明显,我可以使用lens构造函数和一对case语句来编写此代码,但是有更好的方法吗?

outside的文档讨论了将Prism用作一种一流的模式,这听起来很有意义,但我看不出如何实现它。

(编辑:添加了fooName :: Lens' Foo String barName :: Lens' Bar String bazName :: Lens' Baz String 的情况,因为我的真正问题不是与problemName :: Lens' Problem String 同构的。)

3 个答案:

答案 0 :(得分:6)

The function you probably want

choosing :: Functor f => LensLike f s t a b -> LensLike f s' t' a b -> LensLike f (Either s s') (Either t t') a b

应阅读为

choosing :: Lens' s   a      -> Lens' s'  a      -> Lens' (Either s s')    a

或者您的情况

choosing :: Lens' Foo String -> Lens' Bar String -> Lens' (Either Foo Bar) String

要将其与Problem一起使用,您需要一个事实,即Problem实际上与Either Foo Bar同构。同时存在Prism' Problem FooPrism' Problem Bar这还不够,因为您也可以拥有

data Problem' = Problem'Foo Foo
              | Spoilsport
              | Problem'Bar Bar

我不认为有任何标准的TH实用程序可以使用多个构造函数来提供这种同构,但是您可以自己编写它,这比将透镜自己编写到字符串上要容易一些:

delegateProblem :: Iso' Problem (Either Foo Bar)
delegateProblem = iso p2e e2p
 where p2e (ProblemFoo foo) = Left foo
       p2e (ProblemBar bar) = Right bar
       e2p (Left foo) = ProblemFoo foo
       e2p (Right bar) = ProblemBar bar

并以此

problemName :: Lens' Problem String
problemName = delegateProblem . choosing fooName barName

简短版本:

{-# LANGUAGE LambdaCase #-}
problemName = iso (\case ProblemFoo foo -> Left foo
                         ProblemBar bar -> Right bar)
                  (\case Left foo -> ProblemFoo foo
                         Right bar -> ProblemBar bar)
            . choosing fooName barName

答案 1 :(得分:6)

您说对了,可以用outside来写。首先,一些定义:

{-# LANGUAGE TemplateHaskell #-}

import Control.Lens

newtype Foo = Foo { _fooName :: String }
    deriving (Eq, Ord, Show)
makeLenses ''Foo

newtype Bar = Bar { _barName :: String }
    deriving (Eq, Ord, Show)
makeLenses ''Bar

newtype Baz = Baz { _bazName :: String }
    deriving (Eq, Ord, Show)
makeLenses ''Baz

data Problem =
    ProblemFoo Foo |
    ProblemBar Bar |
    ProblemBaz Baz
    deriving (Eq, Ord, Show)
makePrisms ''Problem

以上就是您在问题中所描述的内容,只是我也为Problem做棱镜。

outside的类型(为清楚起见,专门用于功能,简单的透镜和简单的棱镜):

outside :: Prism' s a -> Lens' (s -> r) (a -> r)

给出一个棱镜,例如对于outside的求和类型的案例,您可以了解求和类型的函数,该函数以处理案例的函数分支为目标。指定功能的所有分支等于处理所有情况:

problemName :: Problem -> String
problemName = error "Unhandled case in problemName"
    & outside _ProblemFoo .~ view fooName
    & outside _ProblemBar .~ view barName
    & outside _ProblemBaz .~ view bazName

那很漂亮,除了由于缺乏合理的默认值而需要抛出error情况。 The total library提供了一种替代方法,可以对此进行改进,并在此过程中提供详尽的检查,只要您愿意进一步扭曲类型即可:

{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE DeriveGeneric #-}

import Control.Lens
import GHC.Generics (Generic)
import Lens.Family.Total    

-- etc.

-- This is needed for total's exhaustiveness check.
data Problem_ a b c =
    ProblemFoo a |
    ProblemBar b |
    ProblemBaz c
    deriving (Generic, Eq, Ord, Show)
makePrisms ''Problem_

instance (Empty a, Empty b, Empty c) => Empty (Problem_ a b c)

type Problem = Problem_ Foo Bar Baz

problemName :: Problem -> String
problemName = _case
    & on _ProblemFoo (view fooName)
    & on _ProblemBar (view barName)
    & on _ProblemBaz (view bazName)

答案 2 :(得分:4)

当然,这是非常机械的:

problemName :: Lens' Problem String
problemName f = \case
    ProblemFoo foo -> ProblemFoo <$> fooName f foo
    ProblemBar bar -> ProblemBar <$> barName f bar
    ProblemBaz baz -> ProblemBaz <$> bazName f baz

很明显,如何将其扩展到其他构造函数,或者甚至为它编写一些TH,只要您可以想到一种描述为每个分支选择合适的子透镜的方法-也许使用分派或类似的类型类。