module Chiasma.Ui.Lens.Ident where

import Control.Lens (Prism', prism)

import Chiasma.Data.Ident (Ident, Identifiable (..), sameIdent)

matchIdent :: Identifiable a => Ident -> Traversal' a a
matchIdent :: forall a. Identifiable a => Ident -> Traversal' a a
matchIdent Ident
i =
  (a -> Bool) -> Traversal' a a
forall a. (a -> Bool) -> Traversal' a a
filtered (Ident -> a -> Bool
forall a b. (Identifiable a, Identifiable b) => a -> b -> Bool
sameIdent Ident
i)

matchIdentL :: Identifiable a => Ident -> Traversal' [a] a
matchIdentL :: forall a. Identifiable a => Ident -> Traversal' [a] a
matchIdentL Ident
ident =
  (a -> f a) -> [a] -> f [a]
forall s t a b. Each s t a b => Traversal s t a b
Traversal [a] [a] a a
each ((a -> f a) -> [a] -> f [a])
-> ((a -> f a) -> a -> f a) -> (a -> f a) -> [a] -> f [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ident -> Traversal' a a
forall a. Identifiable a => Ident -> Traversal' a a
matchIdent Ident
ident

identEither :: Identifiable a => Ident -> a -> Either a a
identEither :: forall a. Identifiable a => Ident -> a -> Either a a
identEither Ident
target a
a =
  if Ident -> a -> Bool
forall a b. (Identifiable a, Identifiable b) => a -> b -> Bool
sameIdent Ident
target a
a then a -> Either a a
forall a b. b -> Either a b
Right a
a else a -> Either a a
forall a b. a -> Either a b
Left a
a

matchIdentP :: Identifiable a => Ident -> Prism' a a
matchIdentP :: forall a. Identifiable a => Ident -> Prism' a a
matchIdentP Ident
ident =
  (a -> a) -> (a -> Either a a) -> Prism a a a a
forall b t s a. (b -> t) -> (s -> Either t a) -> Prism s t a b
prism a -> a
forall a. a -> a
id (Ident -> a -> Either a a
forall a. Identifiable a => Ident -> a -> Either a a
identEither Ident
ident)