1-- | 2-- Module: Optics.Cons 3-- Description: Optics to access the left or right element of a container. 4-- 5-- This module defines the 'Cons' and 'Snoc' classes, which provide 'Prism's for 6-- the leftmost and rightmost elements of a container, respectively. 7-- 8{-# LANGUAGE PatternSynonyms #-} 9{-# OPTIONS_GHC -fno-warn-orphans #-} 10module Optics.Cons 11 ( 12 -- * Cons 13 Cons(..) 14 , (<|) 15 , cons 16 , uncons 17 , _head, _tail 18 , pattern (:<) 19 -- * Snoc 20 , Snoc(..) 21 , (|>) 22 , snoc 23 , unsnoc 24 , _init, _last 25 , pattern (:>) 26 ) where 27 28import Data.Vector (Vector) 29import Data.Vector.Primitive (Prim) 30import Data.Vector.Storable (Storable) 31import Data.Vector.Unboxed (Unbox) 32import Data.Word 33import qualified Data.ByteString as StrictB 34import qualified Data.ByteString.Lazy as LazyB 35import qualified Data.Text as StrictT 36import qualified Data.Text.Lazy as LazyT 37import qualified Data.Vector as Vector 38import qualified Data.Vector.Primitive as Prim 39import qualified Data.Vector.Storable as Storable 40import qualified Data.Vector.Unboxed as Unbox 41 42import Optics.Core 43import Optics.Internal.Utils 44 45-- Cons 46 47instance Cons StrictB.ByteString StrictB.ByteString Word8 Word8 where 48 _Cons = prism' (uncurry' StrictB.cons) StrictB.uncons 49 {-# INLINE _Cons #-} 50 51instance Cons LazyB.ByteString LazyB.ByteString Word8 Word8 where 52 _Cons = prism' (uncurry' LazyB.cons) LazyB.uncons 53 {-# INLINE _Cons #-} 54 55instance Cons StrictT.Text StrictT.Text Char Char where 56 _Cons = prism' (uncurry' StrictT.cons) StrictT.uncons 57 {-# INLINE _Cons #-} 58 59instance Cons LazyT.Text LazyT.Text Char Char where 60 _Cons = prism' (uncurry' LazyT.cons) LazyT.uncons 61 {-# INLINE _Cons #-} 62 63instance Cons (Vector a) (Vector b) a b where 64 _Cons = prism (uncurry' Vector.cons) $ \v -> 65 if Vector.null v 66 then Left Vector.empty 67 else Right (Vector.unsafeHead v, Vector.unsafeTail v) 68 {-# INLINE _Cons #-} 69 70instance (Prim a, Prim b) => Cons (Prim.Vector a) (Prim.Vector b) a b where 71 _Cons = prism (uncurry' Prim.cons) $ \v -> 72 if Prim.null v 73 then Left Prim.empty 74 else Right (Prim.unsafeHead v, Prim.unsafeTail v) 75 {-# INLINE _Cons #-} 76 77instance (Storable a, Storable b) => Cons (Storable.Vector a) (Storable.Vector b) a b where 78 _Cons = prism (uncurry' Storable.cons) $ \v -> 79 if Storable.null v 80 then Left Storable.empty 81 else Right (Storable.unsafeHead v, Storable.unsafeTail v) 82 {-# INLINE _Cons #-} 83 84instance (Unbox a, Unbox b) => Cons (Unbox.Vector a) (Unbox.Vector b) a b where 85 _Cons = prism (uncurry' Unbox.cons) $ \v -> 86 if Unbox.null v 87 then Left Unbox.empty 88 else Right (Unbox.unsafeHead v, Unbox.unsafeTail v) 89 {-# INLINE _Cons #-} 90 91-- Snoc 92 93instance Snoc (Vector a) (Vector b) a b where 94 _Snoc = prism (uncurry' Vector.snoc) $ \v -> if Vector.null v 95 then Left Vector.empty 96 else Right (Vector.unsafeInit v, Vector.unsafeLast v) 97 {-# INLINE _Snoc #-} 98 99instance (Prim a, Prim b) => Snoc (Prim.Vector a) (Prim.Vector b) a b where 100 _Snoc = prism (uncurry' Prim.snoc) $ \v -> if Prim.null v 101 then Left Prim.empty 102 else Right (Prim.unsafeInit v, Prim.unsafeLast v) 103 {-# INLINE _Snoc #-} 104 105instance (Storable a, Storable b) => Snoc (Storable.Vector a) (Storable.Vector b) a b where 106 _Snoc = prism (uncurry' Storable.snoc) $ \v -> if Storable.null v 107 then Left Storable.empty 108 else Right (Storable.unsafeInit v, Storable.unsafeLast v) 109 {-# INLINE _Snoc #-} 110 111instance (Unbox a, Unbox b) => Snoc (Unbox.Vector a) (Unbox.Vector b) a b where 112 _Snoc = prism (uncurry' Unbox.snoc) $ \v -> if Unbox.null v 113 then Left Unbox.empty 114 else Right (Unbox.unsafeInit v, Unbox.unsafeLast v) 115 {-# INLINE _Snoc #-} 116 117instance Snoc StrictB.ByteString StrictB.ByteString Word8 Word8 where 118 _Snoc = prism (uncurry' StrictB.snoc) $ \v -> if StrictB.null v 119 then Left StrictB.empty 120 else Right (StrictB.init v, StrictB.last v) 121 {-# INLINE _Snoc #-} 122 123instance Snoc LazyB.ByteString LazyB.ByteString Word8 Word8 where 124 _Snoc = prism (uncurry' LazyB.snoc) $ \v -> if LazyB.null v 125 then Left LazyB.empty 126 else Right (LazyB.init v, LazyB.last v) 127 {-# INLINE _Snoc #-} 128 129instance Snoc StrictT.Text StrictT.Text Char Char where 130 _Snoc = prism (uncurry' StrictT.snoc) $ \v -> if StrictT.null v 131 then Left StrictT.empty 132 else Right (StrictT.init v, StrictT.last v) 133 {-# INLINE _Snoc #-} 134 135instance Snoc LazyT.Text LazyT.Text Char Char where 136 _Snoc = prism (uncurry' LazyT.snoc) $ \v -> if LazyT.null v 137 then Left LazyT.empty 138 else Right (LazyT.init v, LazyT.last v) 139 {-# INLINE _Snoc #-} 140