Pau*_*-AG 4 haskell haskell-lens
在中有/ / etc的at镜头。但是,有没有类似于关联列表类型(可转换为地图)的镜头?MapHashMapControl.Lens.Atat[(k, v)]
我不知道提供给您at的类型At,但属于typeclass ,因此我们当然可以自己编写。为了避免使用灵活的(并且可能重叠的)实例扩展麻烦,我们将在新类型中执行此操作。
newtype AList k v = AList [(k, v)]
Run Code Online (Sandbox Code Playgroud)
首先,我们需要几个家庭实例。
{-# LANGUAGE TypeFamilies #-}
type instance IxValue (AList k v) = v
type instance Index (AList k v) = k
Run Code Online (Sandbox Code Playgroud)
这只是定义了我们新类型中“键”和“值”的含义,这很简单。现在,我们需要能够在特定键处读取和写入值。Haskell已经为我们提供了一种读取值(Data.List.lookup)的方法,但是我们必须自己编写写入函数。这里没有花哨的东西或镜头:只有普通的旧Haskell滤镜和地图。
replaceAt :: Eq k => k -> Maybe v -> AList k v -> AList k v
replaceAt k Nothing (AList m) = AList $ filter (\(k', _) -> k /= k') m
replaceAt k (Just v) (AList m) =
case lookup k m of
Nothing ->
-- Not present in the list; add it
AList ((k, v) : m)
Just _ ->
-- Present; replace it
AList $ map (\(k', v') -> if k == k' then (k', v) else (k', v')) m
Run Code Online (Sandbox Code Playgroud)
现在我们需要编写At实例,具体取决于Ixed实例。幸运的是,Ixed只要我们正在实现At,Lens库就提供了默认实现,因此第一实例声明很简单。
instance Eq k => Ixed (AList k v)
Run Code Online (Sandbox Code Playgroud)
写作at也相当简单。只需查看类型并稍作观察,您所达到的实现就是我们想要的实现。
instance Eq k => At (AList k v) where
at k f (AList m) = fmap (\v' -> replaceAt k v' (AList m)) $ f (lookup k m)
Run Code Online (Sandbox Code Playgroud)
我们完成了。现在at将适用于AList。如果新类型包装器困扰您,您可以很容易地创建一个新函数(at'如果愿意的话),该函数可以为您进行新类型包装/展开。
证明该实例满足镜片定律是留给读者的练习。
完整的代码
{-# LANGUAGE TypeFamilies #-}
import Control.Lens.At
import Data.List(lookup)
newtype AList k v = AList [(k, v)]
type instance IxValue (AList k v) = v
type instance Index (AList k v) = k
replaceAt :: Eq k => k -> Maybe v -> AList k v -> AList k v
replaceAt k Nothing (AList m) = AList $ filter (\(k', _) -> k /= k') m
replaceAt k (Just v) (AList m) =
case lookup k m of
Nothing ->
-- Not present in the list; add it
AList ((k, v) : m)
Just _ ->
-- Present; replace it
AList $ map (\(k', v') -> if k == k' then (k', v) else (k', v')) m
-- Just take the default implementation here.
instance Eq k => Ixed (AList k v)
instance Eq k => At (AList k v) where
at k f (AList m) = fmap (\v' -> replaceAt k v' (AList m)) $ f (lookup k m)
Run Code Online (Sandbox Code Playgroud)