{-# LANGUAGE
NoMonomorphismRestriction
, TemplateHaskell
, TypeOperators
#-}
module Data.Label.Base
(
head
, tail
, left
, right
, just
, fst
, snd
, swap
, fst3
, snd3
, trd3
, readShow
)
where
import Prelude hiding (fst, snd, head, tail)
import Control.Arrow (arr, Kleisli(..), ArrowApply, ArrowZero, ArrowChoice)
import Data.Maybe (listToMaybe)
import Data.Label.Partial (Partial)
import Data.Label
import qualified Data.Label.Mono as Mono
import qualified Data.Label.Poly as Poly
import qualified Data.Tuple as Tuple
head :: (ArrowZero arr, ArrowApply arr, ArrowChoice arr)
=> Mono.Lens arr [a] a
tail :: (ArrowZero arr, ArrowApply arr, ArrowChoice arr)
=> Mono.Lens arr [a] [a]
(Lens arr [a] a
head, Lens arr [a] [a]
tail) = $(getLabel ''[])
left :: (ArrowZero arr, ArrowApply arr, ArrowChoice arr)
=> Poly.Lens arr (Either a b -> Either o b) (a -> o)
right :: (ArrowZero arr, ArrowApply arr, ArrowChoice arr)
=> Poly.Lens arr (Either a b -> Either a o) (b -> o)
(Lens arr (Either a b -> Either o b) (a -> o)
left, Lens arr (Either a b -> Either a o) (b -> o)
right) = $(getLabel ''Either)
just :: (ArrowChoice cat, ArrowZero cat, ArrowApply cat)
=> Poly.Lens cat (Maybe a -> Maybe b) (a -> b)
just :: Lens cat (Maybe a -> Maybe b) (a -> b)
just = $(getLabel ''Maybe)
fst :: ArrowApply arr => Poly.Lens arr ((a, b) -> (o, b)) (a -> o)
snd :: ArrowApply arr => Poly.Lens arr ((a, b) -> (a, o)) (b -> o)
(Lens arr ((a, b) -> (o, b)) (a -> o)
fst, Lens arr ((a, b) -> (a, o)) (b -> o)
snd) = $(getLabel ''(,))
swap :: ArrowApply arr => Poly.Lens arr ((a, b) -> (c, d)) ((b, a) -> (d, c))
swap :: Lens arr ((a, b) -> (c, d)) ((b, a) -> (d, c))
swap = let io :: Iso cat (a, b) (b, a)
io = cat (a, b) (b, a) -> cat (b, a) (a, b) -> Iso cat (a, b) (b, a)
forall (cat :: * -> * -> *) i o. cat i o -> cat o i -> Iso cat i o
Iso (((a, b) -> (b, a)) -> cat (a, b) (b, a)
forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr (a, b) -> (b, a)
forall a b. (a, b) -> (b, a)
Tuple.swap) (((b, a) -> (a, b)) -> cat (b, a) (a, b)
forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr (b, a) -> (a, b)
forall a b. (a, b) -> (b, a)
Tuple.swap) in Iso arr (a, b) (b, a)
-> Iso arr (c, d) (d, c)
-> Lens arr ((a, b) -> (c, d)) ((b, a) -> (d, c))
forall (cat :: * -> * -> *) f o g i.
ArrowApply cat =>
Iso cat f o -> Iso cat g i -> Lens cat (f -> g) (o -> i)
Poly.iso Iso arr (a, b) (b, a)
forall (cat :: * -> * -> *) a b. Arrow cat => Iso cat (a, b) (b, a)
io Iso arr (c, d) (d, c)
forall (cat :: * -> * -> *) a b. Arrow cat => Iso cat (a, b) (b, a)
io
fst3 :: ArrowApply arr => Poly.Lens arr ((a, b, c) -> (o, b, c)) (a -> o)
snd3 :: ArrowApply arr => Poly.Lens arr ((a, b, c) -> (a, o, c)) (b -> o)
trd3 :: ArrowApply arr => Poly.Lens arr ((a, b, c) -> (a, b, o)) (c -> o)
(Lens arr ((a, b, c) -> (o, b, c)) (a -> o)
fst3, Lens arr ((a, b, c) -> (a, o, c)) (b -> o)
snd3, Lens arr ((a, b, c) -> (a, b, o)) (c -> o)
trd3) = $(getLabel ''(,,))
readShow :: (Read a, Show a) => Iso Partial String a
readShow :: Iso Partial String a
readShow = Kleisli Maybe String a
-> Kleisli Maybe a String -> Iso Partial String a
forall (cat :: * -> * -> *) i o. cat i o -> cat o i -> Iso cat i o
Iso Kleisli Maybe String a
forall b. Read b => Kleisli Maybe String b
r Kleisli Maybe a String
forall (a :: * -> * -> *) a. (Arrow a, Show a) => a a String
s
where r :: Kleisli Maybe String b
r = (String -> Maybe b) -> Kleisli Maybe String b
forall (m :: * -> *) a b. (a -> m b) -> Kleisli m a b
Kleisli (((b, String) -> b) -> Maybe (b, String) -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (b, String) -> b
forall a b. (a, b) -> a
Tuple.fst (Maybe (b, String) -> Maybe b)
-> (String -> Maybe (b, String)) -> String -> Maybe b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(b, String)] -> Maybe (b, String)
forall a. [a] -> Maybe a
listToMaybe ([(b, String)] -> Maybe (b, String))
-> (String -> [(b, String)]) -> String -> Maybe (b, String)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String -> [(b, String)]
forall a. Read a => Int -> ReadS a
readsPrec Int
0)
s :: a a String
s = (a -> String) -> a a String
forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr a -> String
forall a. Show a => a -> String
show