{-# LANGUAGE GADTs           #-}
{-# LANGUAGE RankNTypes      #-}
{-# LANGUAGE RecordWildCards #-}
module URI.ByteString.Lens where


-------------------------------------------------------------------------------
import           Control.Applicative
import           Data.ByteString      (ByteString)
import           Data.Word
-------------------------------------------------------------------------------
import           Prelude
-------------------------------------------------------------------------------
import           URI.ByteString.Types
-------------------------------------------------------------------------------


-------------------------------------------------------------------------------

-------------------------------------------------------------------------------
schemeBSL
  :: Lens' Scheme ByteString
schemeBSL :: (ByteString -> f ByteString) -> Scheme -> f Scheme
schemeBSL =
  (Scheme -> ByteString)
-> (Scheme -> ByteString -> Scheme)
-> Lens Scheme Scheme ByteString ByteString
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens Scheme -> ByteString
schemeBS (\Scheme
a ByteString
b -> Scheme
a { schemeBS :: ByteString
schemeBS = ByteString
b})
{-# INLINE schemeBSL #-}

-------------------------------------------------------------------------------
hostBSL
  :: Lens' Host ByteString
hostBSL :: (ByteString -> f ByteString) -> Host -> f Host
hostBSL =
  (Host -> ByteString)
-> (Host -> ByteString -> Host)
-> Lens Host Host ByteString ByteString
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens Host -> ByteString
hostBS (\Host
a ByteString
b -> Host
a { hostBS :: ByteString
hostBS = ByteString
b})
{-# INLINE hostBSL #-}


-------------------------------------------------------------------------------
portNumberL
  :: Lens' Port Int
portNumberL :: (Int -> f Int) -> Port -> f Port
portNumberL =
  (Port -> Int) -> (Port -> Int -> Port) -> Lens Port Port Int Int
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens Port -> Int
portNumber (\Port
a Int
b -> Port
a { portNumber :: Int
portNumber = Int
b})
{-# INLINE portNumberL #-}


-------------------------------------------------------------------------------
authorityUserInfoL
  :: Lens' Authority (Maybe UserInfo)
authorityUserInfoL :: (Maybe UserInfo -> f (Maybe UserInfo)) -> Authority -> f Authority
authorityUserInfoL =
  (Authority -> Maybe UserInfo)
-> (Authority -> Maybe UserInfo -> Authority)
-> Lens Authority Authority (Maybe UserInfo) (Maybe UserInfo)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens Authority -> Maybe UserInfo
authorityUserInfo (\Authority
a Maybe UserInfo
b -> Authority
a { authorityUserInfo :: Maybe UserInfo
authorityUserInfo = Maybe UserInfo
b})
{-# INLINE authorityUserInfoL #-}

-------------------------------------------------------------------------------
authorityHostL
  :: Lens' Authority Host
authorityHostL :: (Host -> f Host) -> Authority -> f Authority
authorityHostL =
  (Authority -> Host)
-> (Authority -> Host -> Authority)
-> Lens Authority Authority Host Host
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens Authority -> Host
authorityHost (\Authority
a Host
b -> Authority
a { authorityHost :: Host
authorityHost = Host
b})
{-# INLINE authorityHostL #-}

-------------------------------------------------------------------------------
authorityPortL
  :: Lens' Authority (Maybe Port)
authorityPortL :: (Maybe Port -> f (Maybe Port)) -> Authority -> f Authority
authorityPortL =
  (Authority -> Maybe Port)
-> (Authority -> Maybe Port -> Authority)
-> Lens Authority Authority (Maybe Port) (Maybe Port)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens Authority -> Maybe Port
authorityPort (\Authority
a Maybe Port
b -> Authority
a { authorityPort :: Maybe Port
authorityPort = Maybe Port
b})
{-# INLINE authorityPortL #-}

-------------------------------------------------------------------------------
uiUsernameL
  :: Lens' UserInfo ByteString
uiUsernameL :: (ByteString -> f ByteString) -> UserInfo -> f UserInfo
uiUsernameL =
  (UserInfo -> ByteString)
-> (UserInfo -> ByteString -> UserInfo)
-> Lens UserInfo UserInfo ByteString ByteString
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens UserInfo -> ByteString
uiUsername (\UserInfo
a ByteString
b -> UserInfo
a { uiUsername :: ByteString
uiUsername = ByteString
b})
{-# INLINE uiUsernameL #-}


-------------------------------------------------------------------------------
uiPasswordL
  :: Lens' UserInfo ByteString
uiPasswordL :: (ByteString -> f ByteString) -> UserInfo -> f UserInfo
uiPasswordL =
  (UserInfo -> ByteString)
-> (UserInfo -> ByteString -> UserInfo)
-> Lens UserInfo UserInfo ByteString ByteString
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens UserInfo -> ByteString
uiPassword (\UserInfo
a ByteString
b -> UserInfo
a { uiPassword :: ByteString
uiPassword = ByteString
b})
{-# INLINE uiPasswordL #-}


-------------------------------------------------------------------------------
queryPairsL
  :: Lens' Query [(ByteString, ByteString)]
queryPairsL :: ([(ByteString, ByteString)] -> f [(ByteString, ByteString)])
-> Query -> f Query
queryPairsL =
  (Query -> [(ByteString, ByteString)])
-> (Query -> [(ByteString, ByteString)] -> Query)
-> Lens
     Query Query [(ByteString, ByteString)] [(ByteString, ByteString)]
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens Query -> [(ByteString, ByteString)]
queryPairs (\Query
a [(ByteString, ByteString)]
b -> Query
a { queryPairs :: [(ByteString, ByteString)]
queryPairs = [(ByteString, ByteString)]
b})
{-# INLINE queryPairsL #-}


-------------------------------------------------------------------------------
uriAuthorityL :: Lens' URI (Maybe Authority)
uriAuthorityL :: (Maybe Authority -> f (Maybe Authority)) -> URI -> f URI
uriAuthorityL =
  (URI -> Maybe Authority)
-> (URI -> Maybe Authority -> URI)
-> Lens URI URI (Maybe Authority) (Maybe Authority)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens URI -> Maybe Authority
uriAuthority (\URI
a Maybe Authority
b -> URI
a { uriAuthority :: Maybe Authority
uriAuthority = Maybe Authority
b})
{-# INLINE uriAuthorityL #-}
{-# DEPRECATED uriAuthorityL "Use 'authorityL' instead" #-}


-------------------------------------------------------------------------------
uriPathL :: Lens' URI ByteString
uriPathL :: (ByteString -> f ByteString) -> URI -> f URI
uriPathL =
  (URI -> ByteString)
-> (URI -> ByteString -> URI) -> Lens URI URI ByteString ByteString
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens URI -> ByteString
uriPath (\URI
a ByteString
b -> URI
a { uriPath :: ByteString
uriPath = ByteString
b})
{-# INLINE uriPathL #-}
{-# DEPRECATED uriPathL "Use 'pathL' instead" #-}


-------------------------------------------------------------------------------
uriQueryL :: Lens' URI Query
uriQueryL :: (Query -> f Query) -> URI -> f URI
uriQueryL =
  (URI -> Query) -> (URI -> Query -> URI) -> Lens URI URI Query Query
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens URI -> Query
uriQuery (\URI
a Query
b -> URI
a { uriQuery :: Query
uriQuery = Query
b})
{-# INLINE uriQueryL #-}
{-# DEPRECATED uriQueryL "Use 'queryL' instead" #-}


-------------------------------------------------------------------------------
uriFragmentL :: Lens' URI (Maybe ByteString)
uriFragmentL :: (Maybe ByteString -> f (Maybe ByteString)) -> URI -> f URI
uriFragmentL =
  (URI -> Maybe ByteString)
-> (URI -> Maybe ByteString -> URI)
-> Lens URI URI (Maybe ByteString) (Maybe ByteString)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens URI -> Maybe ByteString
uriFragment (\URI
a Maybe ByteString
b -> URI
a { uriFragment :: Maybe ByteString
uriFragment = Maybe ByteString
b})
{-# INLINE uriFragmentL #-}
{-# DEPRECATED uriFragmentL "Use 'fragmentL' instead" #-}


-------------------------------------------------------------------------------
rrAuthorityL :: Lens' RelativeRef (Maybe Authority)
rrAuthorityL :: (Maybe Authority -> f (Maybe Authority))
-> RelativeRef -> f RelativeRef
rrAuthorityL =
  (RelativeRef -> Maybe Authority)
-> (RelativeRef -> Maybe Authority -> RelativeRef)
-> Lens RelativeRef RelativeRef (Maybe Authority) (Maybe Authority)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens RelativeRef -> Maybe Authority
rrAuthority (\RelativeRef
a Maybe Authority
b -> RelativeRef
a { rrAuthority :: Maybe Authority
rrAuthority = Maybe Authority
b})
{-# INLINE rrAuthorityL #-}
{-# DEPRECATED rrAuthorityL "Use 'authorityL' instead" #-}


-------------------------------------------------------------------------------
rrPathL :: Lens' RelativeRef ByteString
rrPathL :: (ByteString -> f ByteString) -> RelativeRef -> f RelativeRef
rrPathL =
  (RelativeRef -> ByteString)
-> (RelativeRef -> ByteString -> RelativeRef)
-> Lens RelativeRef RelativeRef ByteString ByteString
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens RelativeRef -> ByteString
rrPath (\RelativeRef
a ByteString
b -> RelativeRef
a { rrPath :: ByteString
rrPath = ByteString
b})
{-# INLINE rrPathL #-}
{-# DEPRECATED rrPathL "Use 'pathL' instead" #-}


-------------------------------------------------------------------------------
rrQueryL :: Lens' RelativeRef Query
rrQueryL :: (Query -> f Query) -> RelativeRef -> f RelativeRef
rrQueryL =
  (RelativeRef -> Query)
-> (RelativeRef -> Query -> RelativeRef)
-> Lens RelativeRef RelativeRef Query Query
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens RelativeRef -> Query
rrQuery (\RelativeRef
a Query
b -> RelativeRef
a { rrQuery :: Query
rrQuery = Query
b})
{-# INLINE rrQueryL #-}
{-# DEPRECATED rrQueryL "Use 'queryL' instead" #-}


-------------------------------------------------------------------------------
rrFragmentL :: Lens' RelativeRef (Maybe ByteString)
rrFragmentL :: (Maybe ByteString -> f (Maybe ByteString))
-> RelativeRef -> f RelativeRef
rrFragmentL =
  (RelativeRef -> Maybe ByteString)
-> (RelativeRef -> Maybe ByteString -> RelativeRef)
-> Lens
     RelativeRef RelativeRef (Maybe ByteString) (Maybe ByteString)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens RelativeRef -> Maybe ByteString
rrFragment (\RelativeRef
a Maybe ByteString
b -> RelativeRef
a { rrFragment :: Maybe ByteString
rrFragment = Maybe ByteString
b})
{-# INLINE rrFragmentL #-}
{-# DEPRECATED rrFragmentL "Use 'fragmentL' instead" #-}


-------------------------------------------------------------------------------
uriSchemeL :: Lens' (URIRef Absolute) Scheme
uriSchemeL :: (Scheme -> f Scheme) -> URI -> f URI
uriSchemeL = (URI -> Scheme)
-> (URI -> Scheme -> URI) -> Lens URI URI Scheme Scheme
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens URI -> Scheme
uriScheme URI -> Scheme -> URI
setter where
  setter :: URIRef Absolute  -> Scheme -> URIRef Absolute
  setter :: URI -> Scheme -> URI
setter (URI Scheme
_ Maybe Authority
b ByteString
c Query
d Maybe ByteString
e) Scheme
a' = Scheme
-> Maybe Authority
-> ByteString
-> Query
-> Maybe ByteString
-> URI
URI Scheme
a' Maybe Authority
b ByteString
c Query
d Maybe ByteString
e
{-# INLINE uriSchemeL #-}


-------------------------------------------------------------------------------
authorityL :: Lens' (URIRef a) (Maybe Authority)
authorityL :: (Maybe Authority -> f (Maybe Authority))
-> URIRef a -> f (URIRef a)
authorityL = (URIRef a -> Maybe Authority)
-> (URIRef a -> Maybe Authority -> URIRef a)
-> Lens (URIRef a) (URIRef a) (Maybe Authority) (Maybe Authority)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens URIRef a -> Maybe Authority
forall a. URIRef a -> Maybe Authority
getter URIRef a -> Maybe Authority -> URIRef a
forall a. URIRef a -> Maybe Authority -> URIRef a
setter where
  getter :: URIRef a -> Maybe Authority
  getter :: URIRef a -> Maybe Authority
getter (URI {Maybe ByteString
Maybe Authority
ByteString
Query
Scheme
uriFragment :: Maybe ByteString
uriQuery :: Query
uriPath :: ByteString
uriAuthority :: Maybe Authority
uriScheme :: Scheme
uriScheme :: URI -> Scheme
uriFragment :: URI -> Maybe ByteString
uriQuery :: URI -> Query
uriPath :: URI -> ByteString
uriAuthority :: URI -> Maybe Authority
..}) = Maybe Authority
uriAuthority
  getter (RelativeRef {Maybe ByteString
Maybe Authority
ByteString
Query
rrFragment :: Maybe ByteString
rrQuery :: Query
rrPath :: ByteString
rrAuthority :: Maybe Authority
rrFragment :: RelativeRef -> Maybe ByteString
rrQuery :: RelativeRef -> Query
rrPath :: RelativeRef -> ByteString
rrAuthority :: RelativeRef -> Maybe Authority
..}) = Maybe Authority
rrAuthority
  setter :: URIRef a -> Maybe Authority -> URIRef a
  setter :: URIRef a -> Maybe Authority -> URIRef a
setter (URI Scheme
a Maybe Authority
_ ByteString
c Query
d Maybe ByteString
e) Maybe Authority
b' = Scheme
-> Maybe Authority
-> ByteString
-> Query
-> Maybe ByteString
-> URI
URI Scheme
a Maybe Authority
b' ByteString
c Query
d Maybe ByteString
e
  setter (RelativeRef Maybe Authority
_ ByteString
c Query
d Maybe ByteString
e) Maybe Authority
b' = Maybe Authority
-> ByteString -> Query -> Maybe ByteString -> RelativeRef
RelativeRef Maybe Authority
b' ByteString
c Query
d Maybe ByteString
e
{-# INLINE authorityL #-}


-------------------------------------------------------------------------------
pathL :: Lens' (URIRef a) ByteString
pathL :: (ByteString -> f ByteString) -> URIRef a -> f (URIRef a)
pathL = (URIRef a -> ByteString)
-> (URIRef a -> ByteString -> URIRef a)
-> Lens (URIRef a) (URIRef a) ByteString ByteString
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens URIRef a -> ByteString
forall a. URIRef a -> ByteString
getter URIRef a -> ByteString -> URIRef a
forall a. URIRef a -> ByteString -> URIRef a
setter where
  getter :: URIRef a -> ByteString
  getter :: URIRef a -> ByteString
getter (URI {Maybe ByteString
Maybe Authority
ByteString
Query
Scheme
uriFragment :: Maybe ByteString
uriQuery :: Query
uriPath :: ByteString
uriAuthority :: Maybe Authority
uriScheme :: Scheme
uriScheme :: URI -> Scheme
uriFragment :: URI -> Maybe ByteString
uriQuery :: URI -> Query
uriPath :: URI -> ByteString
uriAuthority :: URI -> Maybe Authority
..}) = ByteString
uriPath
  getter (RelativeRef {Maybe ByteString
Maybe Authority
ByteString
Query
rrFragment :: Maybe ByteString
rrQuery :: Query
rrPath :: ByteString
rrAuthority :: Maybe Authority
rrFragment :: RelativeRef -> Maybe ByteString
rrQuery :: RelativeRef -> Query
rrPath :: RelativeRef -> ByteString
rrAuthority :: RelativeRef -> Maybe Authority
..}) = ByteString
rrPath
  setter :: URIRef a -> ByteString -> URIRef a
  setter :: URIRef a -> ByteString -> URIRef a
setter (URI Scheme
a Maybe Authority
b ByteString
_ Query
d Maybe ByteString
e) ByteString
c' = Scheme
-> Maybe Authority
-> ByteString
-> Query
-> Maybe ByteString
-> URI
URI Scheme
a Maybe Authority
b ByteString
c' Query
d Maybe ByteString
e
  setter (RelativeRef Maybe Authority
b ByteString
_ Query
d Maybe ByteString
e) ByteString
c' = Maybe Authority
-> ByteString -> Query -> Maybe ByteString -> RelativeRef
RelativeRef Maybe Authority
b ByteString
c' Query
d Maybe ByteString
e
{-# INLINE pathL #-}


-------------------------------------------------------------------------------
queryL :: Lens' (URIRef a) Query
queryL :: (Query -> f Query) -> URIRef a -> f (URIRef a)
queryL = (URIRef a -> Query)
-> (URIRef a -> Query -> URIRef a)
-> Lens (URIRef a) (URIRef a) Query Query
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens URIRef a -> Query
forall a. URIRef a -> Query
getter URIRef a -> Query -> URIRef a
forall a. URIRef a -> Query -> URIRef a
setter where
  getter :: URIRef a -> Query
  getter :: URIRef a -> Query
getter (URI {Maybe ByteString
Maybe Authority
ByteString
Query
Scheme
uriFragment :: Maybe ByteString
uriQuery :: Query
uriPath :: ByteString
uriAuthority :: Maybe Authority
uriScheme :: Scheme
uriScheme :: URI -> Scheme
uriFragment :: URI -> Maybe ByteString
uriQuery :: URI -> Query
uriPath :: URI -> ByteString
uriAuthority :: URI -> Maybe Authority
..}) = Query
uriQuery
  getter (RelativeRef {Maybe ByteString
Maybe Authority
ByteString
Query
rrFragment :: Maybe ByteString
rrQuery :: Query
rrPath :: ByteString
rrAuthority :: Maybe Authority
rrFragment :: RelativeRef -> Maybe ByteString
rrQuery :: RelativeRef -> Query
rrPath :: RelativeRef -> ByteString
rrAuthority :: RelativeRef -> Maybe Authority
..}) = Query
rrQuery
  setter :: URIRef a -> Query -> URIRef a
  setter :: URIRef a -> Query -> URIRef a
setter (URI Scheme
a Maybe Authority
b ByteString
c Query
_ Maybe ByteString
e) Query
d' = Scheme
-> Maybe Authority
-> ByteString
-> Query
-> Maybe ByteString
-> URI
URI Scheme
a Maybe Authority
b ByteString
c Query
d' Maybe ByteString
e
  setter (RelativeRef Maybe Authority
b ByteString
c Query
_ Maybe ByteString
e) Query
d' = Maybe Authority
-> ByteString -> Query -> Maybe ByteString -> RelativeRef
RelativeRef Maybe Authority
b ByteString
c Query
d' Maybe ByteString
e
{-# INLINE queryL #-}


-------------------------------------------------------------------------------
fragmentL :: Lens' (URIRef a) (Maybe ByteString)
fragmentL :: (Maybe ByteString -> f (Maybe ByteString))
-> URIRef a -> f (URIRef a)
fragmentL = (URIRef a -> Maybe ByteString)
-> (URIRef a -> Maybe ByteString -> URIRef a)
-> Lens (URIRef a) (URIRef a) (Maybe ByteString) (Maybe ByteString)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens URIRef a -> Maybe ByteString
forall a. URIRef a -> Maybe ByteString
getter URIRef a -> Maybe ByteString -> URIRef a
forall a. URIRef a -> Maybe ByteString -> URIRef a
setter where
  getter :: URIRef a -> Maybe ByteString
  getter :: URIRef a -> Maybe ByteString
getter (URI {Maybe ByteString
Maybe Authority
ByteString
Query
Scheme
uriFragment :: Maybe ByteString
uriQuery :: Query
uriPath :: ByteString
uriAuthority :: Maybe Authority
uriScheme :: Scheme
uriScheme :: URI -> Scheme
uriFragment :: URI -> Maybe ByteString
uriQuery :: URI -> Query
uriPath :: URI -> ByteString
uriAuthority :: URI -> Maybe Authority
..}) = Maybe ByteString
uriFragment
  getter (RelativeRef {Maybe ByteString
Maybe Authority
ByteString
Query
rrFragment :: Maybe ByteString
rrQuery :: Query
rrPath :: ByteString
rrAuthority :: Maybe Authority
rrFragment :: RelativeRef -> Maybe ByteString
rrQuery :: RelativeRef -> Query
rrPath :: RelativeRef -> ByteString
rrAuthority :: RelativeRef -> Maybe Authority
..}) = Maybe ByteString
rrFragment
  setter :: URIRef a -> Maybe ByteString -> URIRef a
  setter :: URIRef a -> Maybe ByteString -> URIRef a
setter (URI Scheme
a Maybe Authority
b ByteString
c Query
d Maybe ByteString
_) Maybe ByteString
e' = Scheme
-> Maybe Authority
-> ByteString
-> Query
-> Maybe ByteString
-> URI
URI Scheme
a Maybe Authority
b ByteString
c Query
d Maybe ByteString
e'
  setter (RelativeRef Maybe Authority
b ByteString
c Query
d Maybe ByteString
_) Maybe ByteString
e' = Maybe Authority
-> ByteString -> Query -> Maybe ByteString -> RelativeRef
RelativeRef Maybe Authority
b ByteString
c Query
d Maybe ByteString
e'
{-# INLINE fragmentL #-}


-------------------------------------------------------------------------------
upoValidQueryCharL :: Lens' URIParserOptions (Word8 -> Bool)
upoValidQueryCharL :: ((Word8 -> Bool) -> f (Word8 -> Bool))
-> URIParserOptions -> f URIParserOptions
upoValidQueryCharL =
  (URIParserOptions -> Word8 -> Bool)
-> (URIParserOptions -> (Word8 -> Bool) -> URIParserOptions)
-> Lens
     URIParserOptions URIParserOptions (Word8 -> Bool) (Word8 -> Bool)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens URIParserOptions -> Word8 -> Bool
upoValidQueryChar (\URIParserOptions
a Word8 -> Bool
b -> URIParserOptions
a { upoValidQueryChar :: Word8 -> Bool
upoValidQueryChar = Word8 -> Bool
b})
{-# INLINE upoValidQueryCharL #-}


-------------------------------------------------------------------------------
-- Lens machinery
-------------------------------------------------------------------------------
-- Unexported type aliases to clean up the documentation
type Lens s t a b = forall f. Functor f => (a -> f b) -> s -> f t

type Lens' s a = Lens s s a a


-------------------------------------------------------------------------------
lens :: (s -> a) -> (s -> b -> t) -> Lens s t a b
lens :: (s -> a) -> (s -> b -> t) -> Lens s t a b
lens s -> a
sa s -> b -> t
sbt a -> f b
afb s
s = s -> b -> t
sbt s
s (b -> t) -> f b -> f t
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> f b
afb (s -> a
sa s
s)
{-# INLINE lens #-}