    {-# LANGUAGE CPP #-}
    {-# LANGUAGE DataKinds #-}
    {-# LANGUAGE LambdaCase #-}
    {-# LANGUAGE RankNTypes #-}
    {-# LANGUAGE TupleSections #-}

    -- |
    -- Module      :  Text.URI.Lens
    -- Copyright   :  © 2017–present Mark Karpov
    -- License     :  BSD 3 clause
    --
    -- Maintainer  :  Mark Karpov <markkarpov92@gmail.com>
    -- Stability   :  experimental
    -- Portability :  portable
    --
    -- Lenses for working with the 'URI' data type and its internals.
    module Text.URI.Lens
      ( uriScheme,
        uriAuthority,
        uriPath,
        isPathAbsolute,
        uriTrailingSlash,
        uriQuery,
        uriFragment,
        authUserInfo,
        authHost,
        authPort,
        uiUsername,
        uiPassword,
        _QueryFlag,
        _QueryParam,
        queryFlag,
        queryParam,
        unRText,
      )
    where

    import Data.Foldable (find)
    import Data.Functor.Contravariant
    import qualified Data.List.NonEmpty as NE
    import Data.Maybe (isJust)
    import Data.Profunctor
    import Data.Text (Text)
    import Text.URI.Types
      ( Authority,
        QueryParam (..),
        RText,
        RTextLabel (..),
        URI,
        UserInfo,
      )
    import qualified Text.URI.Types as URI

    #if !MIN_VERSION_base(4,18,0)
    import Control.Applicative (liftA2)
    #endif

    -- | 'URI' scheme lens.
    uriScheme :: Lens' URI (Maybe (RText 'Scheme))
    uriScheme :: Lens' URI (Maybe (RText 'Scheme))
    uriScheme Maybe (RText 'Scheme) -> f (Maybe (RText 'Scheme))
    f URI
    s = (\Maybe (RText 'Scheme)
    x -> URI
    s {URI.uriScheme = x}) (Maybe (RText 'Scheme) -> URI)
    -> f (Maybe (RText 'Scheme)) -> f URI
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Maybe (RText 'Scheme) -> f (Maybe (RText 'Scheme))
    f (URI -> Maybe (RText 'Scheme)
    URI.uriScheme URI
    s)

    -- | 'URI' authority lens.
    --
    -- __Note__: before version /0.1.0.0/ this lens allowed to focus on @'Maybe'
    -- 'URI.Authority'@.
    uriAuthority :: Lens' URI (Either Bool URI.Authority)
    uriAuthority :: Lens' URI (Either Bool Authority)
    uriAuthority Either Bool Authority -> f (Either Bool Authority)
    f URI
    s = (\Either Bool Authority
    x -> URI
    s {URI.uriAuthority = x}) (Either Bool Authority -> URI)
    -> f (Either Bool Authority) -> f URI
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Either Bool Authority -> f (Either Bool Authority)
    f (URI -> Either Bool Authority
    URI.uriAuthority URI
    s)

    -- | 'URI' path lens.
    uriPath :: Lens' URI [RText 'PathPiece]
    uriPath :: Lens' URI [RText 'PathPiece]
    uriPath [RText 'PathPiece] -> f [RText 'PathPiece]
    f URI
    s = (\[RText 'PathPiece]
    x -> URI
    s {URI.uriPath = (ts,) <$> NE.nonEmpty x}) ([RText 'PathPiece] -> URI) -> f [RText 'PathPiece] -> f URI
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> [RText 'PathPiece] -> f [RText 'PathPiece]
    f [RText 'PathPiece]
    ps
      where
        ts :: Bool
    ts = Bool
    -> ((Bool, NonEmpty (RText 'PathPiece)) -> Bool)
    -> Maybe (Bool, NonEmpty (RText 'PathPiece))
    -> Bool
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe Bool
    False (Bool, NonEmpty (RText 'PathPiece)) -> Bool
    forall a b. (a, b) -> a
    fst Maybe (Bool, NonEmpty (RText 'PathPiece))
    path
        ps :: [RText 'PathPiece]
    ps = [RText 'PathPiece]
    -> ((Bool, NonEmpty (RText 'PathPiece)) -> [RText 'PathPiece])
    -> Maybe (Bool, NonEmpty (RText 'PathPiece))
    -> [RText 'PathPiece]
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe [] (NonEmpty (RText 'PathPiece) -> [RText 'PathPiece]
    forall a. NonEmpty a -> [a]
    NE.toList (NonEmpty (RText 'PathPiece) -> [RText 'PathPiece])
    -> ((Bool, NonEmpty (RText 'PathPiece))
        -> NonEmpty (RText 'PathPiece))
    -> (Bool, NonEmpty (RText 'PathPiece))
    -> [RText 'PathPiece]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Bool, NonEmpty (RText 'PathPiece)) -> NonEmpty (RText 'PathPiece)
    forall a b. (a, b) -> b
    snd) Maybe (Bool, NonEmpty (RText 'PathPiece))
    path
        path :: Maybe (Bool, NonEmpty (RText 'PathPiece))
    path = URI -> Maybe (Bool, NonEmpty (RText 'PathPiece))
    URI.uriPath URI
    s

    -- | A getter that can tell if path component of a 'URI' is absolute.
    --
    -- @since 0.1.0.0
    isPathAbsolute :: Getter URI Bool
    isPathAbsolute :: Getter URI Bool
    isPathAbsolute = (URI -> Bool) -> (Bool -> f Bool) -> URI -> f URI
    forall (p :: * -> * -> *) (f :: * -> *) s a.
    (Profunctor p, Contravariant f) =>
    (s -> a) -> p a (f a) -> p s (f s)
    to URI -> Bool
    URI.isPathAbsolute

    -- | A 0-1 traversal allowing to view and manipulate trailing slash.
    --
    -- @since 0.2.0.0
    uriTrailingSlash :: Traversal' URI Bool
    uriTrailingSlash :: Traversal' URI Bool
    uriTrailingSlash Bool -> f Bool
    f URI
    s =
      (\Maybe Bool
    x -> URI
    s {URI.uriPath = liftA2 (,) x ps}) (Maybe Bool -> URI) -> f (Maybe Bool) -> f URI
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> (Bool -> f Bool) -> Maybe Bool -> f (Maybe Bool)
    forall (t :: * -> *) (f :: * -> *) a b.
    (Traversable t, Applicative f) =>
    (a -> f b) -> t a -> f (t b)
    forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> Maybe a -> f (Maybe b)
    traverse Bool -> f Bool
    f Maybe Bool
    ts
      where
        ts :: Maybe Bool
    ts = (Bool, NonEmpty (RText 'PathPiece)) -> Bool
    forall a b. (a, b) -> a
    fst ((Bool, NonEmpty (RText 'PathPiece)) -> Bool)
    -> Maybe (Bool, NonEmpty (RText 'PathPiece)) -> Maybe Bool
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Maybe (Bool, NonEmpty (RText 'PathPiece))
    path
        ps :: Maybe (NonEmpty (RText 'PathPiece))
    ps = (Bool, NonEmpty (RText 'PathPiece)) -> NonEmpty (RText 'PathPiece)
    forall a b. (a, b) -> b
    snd ((Bool, NonEmpty (RText 'PathPiece))
     -> NonEmpty (RText 'PathPiece))
    -> Maybe (Bool, NonEmpty (RText 'PathPiece))
    -> Maybe (NonEmpty (RText 'PathPiece))
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Maybe (Bool, NonEmpty (RText 'PathPiece))
    path
        path :: Maybe (Bool, NonEmpty (RText 'PathPiece))
    path = URI -> Maybe (Bool, NonEmpty (RText 'PathPiece))
    URI.uriPath URI
    s

    -- | 'URI' query params lens.
    uriQuery :: Lens' URI [URI.QueryParam]
    uriQuery :: Lens' URI [QueryParam]
    uriQuery [QueryParam] -> f [QueryParam]
    f URI
    s = (\[QueryParam]
    x -> URI
    s {URI.uriQuery = x}) ([QueryParam] -> URI) -> f [QueryParam] -> f URI
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> [QueryParam] -> f [QueryParam]
    f (URI -> [QueryParam]
    URI.uriQuery URI
    s)

    -- | 'URI' fragment lens.
    uriFragment :: Lens' URI (Maybe (RText 'Fragment))
    uriFragment :: Lens' URI (Maybe (RText 'Fragment))
    uriFragment Maybe (RText 'Fragment) -> f (Maybe (RText 'Fragment))
    f URI
    s = (\Maybe (RText 'Fragment)
    x -> URI
    s {URI.uriFragment = x}) (Maybe (RText 'Fragment) -> URI)
    -> f (Maybe (RText 'Fragment)) -> f URI
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Maybe (RText 'Fragment) -> f (Maybe (RText 'Fragment))
    f (URI -> Maybe (RText 'Fragment)
    URI.uriFragment URI
    s)

    -- | 'Authority' user info lens.
    authUserInfo :: Lens' Authority (Maybe URI.UserInfo)
    authUserInfo :: Lens' Authority (Maybe UserInfo)
    authUserInfo Maybe UserInfo -> f (Maybe UserInfo)
    f Authority
    s = (\Maybe UserInfo
    x -> Authority
    s {URI.authUserInfo = x}) (Maybe UserInfo -> Authority) -> f (Maybe UserInfo) -> f Authority
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Maybe UserInfo -> f (Maybe UserInfo)
    f (Authority -> Maybe UserInfo
    URI.authUserInfo Authority
    s)

    -- | 'Authority' host lens.
    authHost :: Lens' Authority (RText 'Host)
    authHost :: Lens' Authority (RText 'Host)
    authHost RText 'Host -> f (RText 'Host)
    f Authority
    s = (\RText 'Host
    x -> Authority
    s {URI.authHost = x}) (RText 'Host -> Authority) -> f (RText 'Host) -> f Authority
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> RText 'Host -> f (RText 'Host)
    f (Authority -> RText 'Host
    URI.authHost Authority
    s)

    -- | 'Authority' port lens.
    authPort :: Lens' Authority (Maybe Word)
    authPort :: Lens' Authority (Maybe Word)
    authPort Maybe Word -> f (Maybe Word)
    f Authority
    s = (\Maybe Word
    x -> Authority
    s {URI.authPort = x}) (Maybe Word -> Authority) -> f (Maybe Word) -> f Authority
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Maybe Word -> f (Maybe Word)
    f (Authority -> Maybe Word
    URI.authPort Authority
    s)

    -- | 'UserInfo' username lens.
    uiUsername :: Lens' UserInfo (RText 'Username)
    uiUsername :: Lens' UserInfo (RText 'Username)
    uiUsername RText 'Username -> f (RText 'Username)
    f UserInfo
    s = (\RText 'Username
    x -> UserInfo
    s {URI.uiUsername = x}) (RText 'Username -> UserInfo) -> f (RText 'Username) -> f UserInfo
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> RText 'Username -> f (RText 'Username)
    f (UserInfo -> RText 'Username
    URI.uiUsername UserInfo
    s)

    -- | 'UserInfo' password lens.
    uiPassword :: Lens' UserInfo (Maybe (RText 'Password))
    uiPassword :: Lens' UserInfo (Maybe (RText 'Password))
    uiPassword Maybe (RText 'Password) -> f (Maybe (RText 'Password))
    f UserInfo
    s = (\Maybe (RText 'Password)
    x -> UserInfo
    s {URI.uiPassword = x}) (Maybe (RText 'Password) -> UserInfo)
    -> f (Maybe (RText 'Password)) -> f UserInfo
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Maybe (RText 'Password) -> f (Maybe (RText 'Password))
    f (UserInfo -> Maybe (RText 'Password)
    URI.uiPassword UserInfo
    s)

    -- | 'QueryParam' prism for query flags.
    _QueryFlag :: Prism' URI.QueryParam (RText 'QueryKey)
    _QueryFlag :: Prism' QueryParam (RText 'QueryKey)
    _QueryFlag = (RText 'QueryKey -> QueryParam)
    -> (QueryParam -> Maybe (RText 'QueryKey))
    -> Prism' QueryParam (RText 'QueryKey)
    forall b s a. (b -> s) -> (s -> Maybe a) -> Prism s s a b
    prism' RText 'QueryKey -> QueryParam
    QueryFlag ((QueryParam -> Maybe (RText 'QueryKey))
     -> Prism' QueryParam (RText 'QueryKey))
    -> (QueryParam -> Maybe (RText 'QueryKey))
    -> Prism' QueryParam (RText 'QueryKey)
    forall a b. (a -> b) -> a -> b
    $ \case
      QueryFlag RText 'QueryKey
    x -> RText 'QueryKey -> Maybe (RText 'QueryKey)
    forall a. a -> Maybe a
    Just RText 'QueryKey
    x
      QueryParam
    _ -> Maybe (RText 'QueryKey)
    forall a. Maybe a
    Nothing

    -- | 'QueryParam' prism for query parameters.
    _QueryParam :: Prism' QueryParam (RText 'QueryKey, RText 'QueryValue)
    _QueryParam :: Prism' QueryParam (RText 'QueryKey, RText 'QueryValue)
    _QueryParam = ((RText 'QueryKey, RText 'QueryValue) -> QueryParam)
    -> (QueryParam -> Maybe (RText 'QueryKey, RText 'QueryValue))
    -> Prism' QueryParam (RText 'QueryKey, RText 'QueryValue)
    forall b s a. (b -> s) -> (s -> Maybe a) -> Prism s s a b
    prism' (RText 'QueryKey, RText 'QueryValue) -> QueryParam
    construct QueryParam -> Maybe (RText 'QueryKey, RText 'QueryValue)
    pick
      where
        construct :: (RText 'QueryKey, RText 'QueryValue) -> QueryParam
    construct (RText 'QueryKey
    x, RText 'QueryValue
    y) = RText 'QueryKey -> RText 'QueryValue -> QueryParam
    QueryParam RText 'QueryKey
    x RText 'QueryValue
    y
        pick :: QueryParam -> Maybe (RText 'QueryKey, RText 'QueryValue)
    pick = \case
          QueryParam RText 'QueryKey
    x RText 'QueryValue
    y -> (RText 'QueryKey, RText 'QueryValue)
    -> Maybe (RText 'QueryKey, RText 'QueryValue)
    forall a. a -> Maybe a
    Just (RText 'QueryKey
    x, RText 'QueryValue
    y)
          QueryParam
    _ -> Maybe (RText 'QueryKey, RText 'QueryValue)
    forall a. Maybe a
    Nothing

    -- | Check if the given query key is present in the collection of query
    -- parameters.
    queryFlag :: RText 'QueryKey -> Getter [URI.QueryParam] Bool
    queryFlag :: RText 'QueryKey -> Getter [QueryParam] Bool
    queryFlag RText 'QueryKey
    k = ([QueryParam] -> Bool)
    -> (Bool -> f Bool) -> [QueryParam] -> f [QueryParam]
    forall (p :: * -> * -> *) (f :: * -> *) s a.
    (Profunctor p, Contravariant f) =>
    (s -> a) -> p a (f a) -> p s (f s)
    to (Maybe QueryParam -> Bool
    forall a. Maybe a -> Bool
    isJust (Maybe QueryParam -> Bool)
    -> ([QueryParam] -> Maybe QueryParam) -> [QueryParam] -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (QueryParam -> Bool) -> [QueryParam] -> Maybe QueryParam
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
    find QueryParam -> Bool
    g)
      where
        g :: QueryParam -> Bool
    g (QueryFlag RText 'QueryKey
    k') = RText 'QueryKey
    k' RText 'QueryKey -> RText 'QueryKey -> Bool
    forall a. Eq a => a -> a -> Bool
    == RText 'QueryKey
    k
        g QueryParam
    _ = Bool
    False

    -- | Manipulate a query parameter by its key. Note that since there may be
    -- several query parameters with the same key this is a traversal that can
    -- return\/modify several items at once.
    queryParam :: RText 'QueryKey -> Traversal' [URI.QueryParam] (RText 'QueryValue)
    queryParam :: RText 'QueryKey -> Traversal' [QueryParam] (RText 'QueryValue)
    queryParam RText 'QueryKey
    k RText 'QueryValue -> f (RText 'QueryValue)
    f = (QueryParam -> f QueryParam) -> [QueryParam] -> f [QueryParam]
    forall (t :: * -> *) (f :: * -> *) a b.
    (Traversable t, Applicative f) =>
    (a -> f b) -> t a -> f (t b)
    forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> [a] -> f [b]
    traverse QueryParam -> f QueryParam
    g
      where
        g :: QueryParam -> f QueryParam
    g p :: QueryParam
    p@(QueryParam RText 'QueryKey
    k' RText 'QueryValue
    v) =
          if RText 'QueryKey
    k RText 'QueryKey -> RText 'QueryKey -> Bool
    forall a. Eq a => a -> a -> Bool
    == RText 'QueryKey
    k'
            then RText 'QueryKey -> RText 'QueryValue -> QueryParam
    QueryParam RText 'QueryKey
    k' (RText 'QueryValue -> QueryParam)
    -> f (RText 'QueryValue) -> f QueryParam
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> RText 'QueryValue -> f (RText 'QueryValue)
    f RText 'QueryValue
    v
            else QueryParam -> f QueryParam
    forall a. a -> f a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure QueryParam
    p
        g QueryParam
    p = QueryParam -> f QueryParam
    forall a. a -> f a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure QueryParam
    p

    -- | A getter that can project 'Text' from refined text values.
    unRText :: Getter (RText l) Text
    unRText :: forall (l :: RTextLabel) (f :: * -> *).
    (Contravariant f, Functor f) =>
    (Text -> f Text) -> RText l -> f (RText l)
    unRText = (RText l -> Text) -> (Text -> f Text) -> RText l -> f (RText l)
    forall (p :: * -> * -> *) (f :: * -> *) s a.
    (Profunctor p, Contravariant f) =>
    (s -> a) -> p a (f a) -> p s (f s)
    to RText l -> Text
    forall (l :: RTextLabel). RText l -> Text
    URI.unRText

    ----------------------------------------------------------------------------
    -- Helpers

    type Lens' s a =
      forall f. (Functor f) => (a -> f a) -> s -> f s

    type Traversal' s a =
      forall f. (Applicative f) => (a -> f a) -> s -> f s

    type Getter s a =
      forall f. (Contravariant f, Functor f) => (a -> f a) -> s -> f s

    type Prism s t a b =
      forall p f. (Choice p, Applicative f) => p a (f b) -> p s (f t)

    type Prism' s a = Prism s s a a

    -- | Build a 'Prism'.
    prism :: (b -> t) -> (s -> Either t a) -> Prism s t a b
    prism :: forall b t s a. (b -> t) -> (s -> Either t a) -> Prism s t a b
    prism b -> t
    bt s -> Either t a
    seta = (s -> Either t a)
    -> (Either t (f b) -> f t)
    -> p (Either t a) (Either t (f b))
    -> p s (f t)
    forall a b c d. (a -> b) -> (c -> d) -> p b c -> p a d
    forall (p :: * -> * -> *) a b c d.
    Profunctor p =>
    (a -> b) -> (c -> d) -> p b c -> p a d
    dimap s -> Either t a
    seta ((t -> f t) -> (f b -> f t) -> Either t (f b) -> f t
    forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
    either t -> f t
    forall a. a -> f a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure ((b -> t) -> f b -> f t
    forall a b. (a -> b) -> f a -> f b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap b -> t
    bt)) (p (Either t a) (Either t (f b)) -> p s (f t))
    -> (p a (f b) -> p (Either t a) (Either t (f b)))
    -> p a (f b)
    -> p s (f t)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . p a (f b) -> p (Either t a) (Either t (f b))
    forall a b c. p a b -> p (Either c a) (Either c b)
    forall (p :: * -> * -> *) a b c.
    Choice p =>
    p a b -> p (Either c a) (Either c b)
    right'

    -- | Another way to build a 'Prism'.
    prism' :: (b -> s) -> (s -> Maybe a) -> Prism s s a b
    prism' :: forall b s a. (b -> s) -> (s -> Maybe a) -> Prism s s a b
    prism' b -> s
    bs s -> Maybe a
    sma = (b -> s) -> (s -> Either s a) -> Prism s s a b
    forall b t s a. (b -> t) -> (s -> Either t a) -> Prism s t a b
    prism b -> s
    bs (\s
    s -> Either s a -> (a -> Either s a) -> Maybe a -> Either s a
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe (s -> Either s a
    forall a b. a -> Either a b
    Left s
    s) a -> Either s a
    forall a b. b -> Either a b
    Right (s -> Maybe a
    sma s
    s))

    -- | Lift a function into optic.
    to :: (Profunctor p, Contravariant f) => (s -> a) -> (p a (f a) -> p s (f s))
    to :: forall (p :: * -> * -> *) (f :: * -> *) s a.
    (Profunctor p, Contravariant f) =>
    (s -> a) -> p a (f a) -> p s (f s)
    to s -> a
    f = (s -> a) -> (f a -> f s) -> p a (f a) -> p s (f s)
    forall a b c d. (a -> b) -> (c -> d) -> p b c -> p a d
    forall (p :: * -> * -> *) a b c d.
    Profunctor p =>
    (a -> b) -> (c -> d) -> p b c -> p a d
    dimap s -> a
    f ((s -> a) -> f a -> f s
    forall a' a. (a' -> a) -> f a -> f a'
    forall (f :: * -> *) a' a.
    Contravariant f =>
    (a' -> a) -> f a -> f a'
    contramap s -> a
    f)