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