@@ -0,0 +1,101 @@
1+{-# LANGUAGE AllowAmbiguousTypes #-}
2+{-# LANGUAGE RankNTypes #-}
3+{-# LANGUAGE ScopedTypeVariables #-}
4+{-# LANGUAGE TemplateHaskell #-}
5+{-# LANGUAGE TypeApplications #-}
6+
7+module Control.Lens.Missing
8+ ( -- * URI
9+ _uriScheme
10+ , _uriAuthority
11+ , _uriPath
12+ , _uriQuery
13+ , _uriFragment
14+ -- ** Authority
15+ , _uriUserInfo
16+ , _uriRegName
17+ , _uriPort
18+ -- * NonEmpty
19+ , _NonEmptyHead
20+ , _NonEmptyLast
21+ , _NonEmptyList
22+ -- * Text
23+ , utf8
24+ , notNullText
25+ -- * Email Address
26+ , emailAddressBytes
27+ , emailAddressText
28+ -- * UUID
29+ , uuidText
30+ -- * API ints
31+ , apiInt
32+ , apiInteger
33+ -- * Coercible
34+ , coercing
35+ ) where
36+
37+import Control.Lens
38+import Data.ByteString as BS
39+import Data.Coerce
40+import Data.List as L
41+import Data.List.NonEmpty as NE
42+import Data.Scientific
43+import Data.Text as T
44+import Data.Text.Encoding as T
45+import Data.UUID
46+import Network.URI
47+import Text.Email.Validate as Email
48+
49+
50+makeLensesFor
51+ (L.map (\a -> (a, "_" ++ a))
52+ ["uriScheme", "uriAuthority", "uriPath", "uriQuery", "uriFragment"])
53+ ''URI
54+
55+makeLensesFor
56+ (L.map (\a -> (a, "_" ++ a))
57+ ["uriUserInfo", "uriRegName", "uriPort"])
58+ ''URIAuth
59+
60+_NonEmptyHead :: Lens' (NonEmpty a) a
61+_NonEmptyHead f (a :| as) = f a <&> \a' -> a' :| as
62+
63+_NonEmptyLast :: Lens' (NonEmpty a) a
64+_NonEmptyLast = reversed . _NonEmptyHead
65+
66+_NonEmptyList :: Prism' [a] (NonEmpty a)
67+_NonEmptyList = prism' NE.toList nonEmpty
68+
69+-- | Utf8-encoding @ByteString@-@Text@ @Iso@morphism.
70+utf8 :: Iso' Text BS.ByteString
71+utf8 = iso encodeUtf8 decodeUtf8
72+
73+-- | Prism returns text if it is not empty.
74+notNullText :: Prism' Text Text
75+notNullText = prism id $ \t -> if T.null t then Left t else Right t
76+
77+uuidText :: Prism' Text UUID
78+uuidText = prism' (T.pack . toString) (fromString . T.unpack)
79+
80+emailAddressBytes :: Prism' ByteString EmailAddress
81+emailAddressBytes = prism' Email.toByteString emailAddress
82+
83+emailAddressText :: Prism' Text EmailAddress
84+emailAddressText = utf8 . emailAddressBytes
85+
86+apiInt :: Getter Int Scientific
87+apiInt = to (flip scientific 0 . toInteger)
88+
89+apiInteger :: Getter Integer Scientific
90+apiInteger = to (flip scientific 0)
91+
92+-- | A @Simple@ version of @coerced@.
93+--
94+-- This can be useful when you need to explicitly specify the types.
95+--
96+-- >>> foo ^. pnr . coercing @APIPnr @Pnr -- coercing from APIPnr to Pnr
97+--
98+-- This would be cumbersome to explicitly specify using @coerced@:
99+-- >>> foo ^. pnr . coerced @APIPnr @APIPnr @Pnr
100+coercing :: forall s a. (Coercible s a) => Iso' s a
101+coercing = coerced