    {-# LANGUAGE CPP, DeriveDataTypeable, OverloadedStrings, PackageImports, RecordWildCards, ScopedTypeVariables, StandaloneDeriving, TemplateHaskell, TypeFamilies #-}
    {-# LANGUAGE FlexibleContexts #-}
    {-# OPTIONS -Wall -fno-warn-orphans #-}

    module Debian.URI
        ( module Network.URI

    #if 0
        , _NodeElement -- :: Prism' Node Element
        , _NodeContent -- :: Prism' Node Text
        , eltAttrsLens -- :: Lens' Element (HashMap AttrName AttrValue)
        , eltChildrenLens --  :: Lens' Element [Node]
        , eltNameLens -- :: Lens' Element Text
    #endif

        , URIError(..)
        , uriSchemeLens
        , uriAuthorityLens
        , uriPathLens
        , uriQueryLens
        , uriFragmentLens
        -- * String known to parsable by parseURIReference.  Mainly
        -- useful because it has a Read instance.
        , URI'(..)
        , fromURI'
        , toURI'
        , readURI'

        -- Show URI as a Haskell expression
        , showURI
        -- Monadic URI parsers
        , parseURIReference'
        , parseURI'
        , parseAbsoluteURI'
        , parseRelativeReference'
        , parseURIUnsafe
        -- URI appending
        , appendURI
        , appendURIs
        , parentURI
        , uriToString'
        -- * Lift IO operations into a MonadError instance
        , HasParseError(fromParseError)
        , HasURIError(fromURIError)
        -- * QuickCheck properties
        , prop_print_parse
        , prop_append_singleton
        ) where

    import Control.Lens (makeLensesFor)
    import Control.Monad.Except (MonadError, throwError)
    import Data.Foldable (foldrM)
    import Data.Maybe (fromJust, fromMaybe)
    #if !MIN_VERSION_base(4,11,0)
    import Data.Monoid ((<>))
    #endif
    import Network.URI (nullURI, parseURIReference, parseURI, parseAbsoluteURI, parseRelativeReference, URI(..), URIAuth(..), uriToString)
    import System.FilePath ((</>), dropTrailingPathSeparator, takeDirectory)
    import Text.Parsec (ParseError)

    $(makeLensesFor [("uriScheme", "uriSchemeLens"),
                     ("uriAuthority", "uriAuthorityLens"),
                     ("uriPath", "uriPathLens"),
                     ("uriQuery", "uriQueryLens"),
                     ("uriFragment", "uriFragmentLens")] ''URI)

    showURI :: URI -> String
    showURI :: URI -> [Char]
    showURI (URI {[Char]
    Maybe URIAuth
    uriScheme :: [Char]
    uriAuthority :: Maybe URIAuth
    uriPath :: [Char]
    uriQuery :: [Char]
    uriFragment :: [Char]
    uriFragment :: URI -> [Char]
    uriQuery :: URI -> [Char]
    uriPath :: URI -> [Char]
    uriAuthority :: URI -> Maybe URIAuth
    uriScheme :: URI -> [Char]
    ..}) =
        [Char]
    "URI {uriScheme = " [Char] -> [Char] -> [Char]
    forall a. Semigroup a => a -> a -> a
    <> [Char] -> [Char]
    forall a. Show a => a -> [Char]
    show [Char]
    uriScheme [Char] -> [Char] -> [Char]
    forall a. Semigroup a => a -> a -> a
    <>
           [Char]
    ", uriAuthority = " [Char] -> [Char] -> [Char]
    forall a. Semigroup a => a -> a -> a
    <> Maybe URIAuth -> [Char]
    forall a. Show a => a -> [Char]
    show Maybe URIAuth
    uriAuthority [Char] -> [Char] -> [Char]
    forall a. Semigroup a => a -> a -> a
    <>
           [Char]
    ", uriPath = " [Char] -> [Char] -> [Char]
    forall a. Semigroup a => a -> a -> a
    <> [Char] -> [Char]
    forall a. Show a => a -> [Char]
    show [Char]
    uriPath [Char] -> [Char] -> [Char]
    forall a. Semigroup a => a -> a -> a
    <>
           [Char]
    ", uriQuery = " [Char] -> [Char] -> [Char]
    forall a. Semigroup a => a -> a -> a
    <> [Char] -> [Char]
    forall a. Show a => a -> [Char]
    show [Char]
    uriQuery [Char] -> [Char] -> [Char]
    forall a. Semigroup a => a -> a -> a
    <>
           [Char]
    ", uriFragment = " [Char] -> [Char] -> [Char]
    forall a. Semigroup a => a -> a -> a
    <> [Char] -> [Char]
    forall a. Show a => a -> [Char]
    show [Char]
    uriFragment [Char] -> [Char] -> [Char]
    forall a. Semigroup a => a -> a -> a
    <> [Char]
    "}"

    -- | parseURI with MonadError
    parseURI' :: (HasURIError e, MonadError e m) => String -> m URI
    parseURI' :: forall e (m :: * -> *).
    (HasURIError e, MonadError e m) =>
    [Char] -> m URI
    parseURI' [Char]
    s = m URI -> (URI -> m URI) -> Maybe URI -> m URI
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe (e -> m URI
    forall a. e -> m a
    forall e (m :: * -> *) a. MonadError e m => e -> m a
    throwError (e -> m URI) -> e -> m URI
    forall a b. (a -> b) -> a -> b
    $ URIError -> e
    forall e. HasURIError e => URIError -> e
    fromURIError (URIError -> e) -> URIError -> e
    forall a b. (a -> b) -> a -> b
    $ [Char] -> [Char] -> URIError
    URIParseError [Char]
    "parseURI" [Char]
    s) URI -> m URI
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ([Char] -> Maybe URI
    parseURI [Char]
    s)
    parseURIReference' :: (HasURIError e, MonadError e m) => String -> m URI
    parseURIReference' :: forall e (m :: * -> *).
    (HasURIError e, MonadError e m) =>
    [Char] -> m URI
    parseURIReference' [Char]
    s = m URI -> (URI -> m URI) -> Maybe URI -> m URI
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe (e -> m URI
    forall a. e -> m a
    forall e (m :: * -> *) a. MonadError e m => e -> m a
    throwError (e -> m URI) -> e -> m URI
    forall a b. (a -> b) -> a -> b
    $ URIError -> e
    forall e. HasURIError e => URIError -> e
    fromURIError (URIError -> e) -> URIError -> e
    forall a b. (a -> b) -> a -> b
    $ [Char] -> [Char] -> URIError
    URIParseError [Char]
    "parseURIReference" [Char]
    s) URI -> m URI
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ([Char] -> Maybe URI
    parseURIReference [Char]
    s)
    parseAbsoluteURI' :: (HasURIError e, MonadError e m) => String -> m URI
    parseAbsoluteURI' :: forall e (m :: * -> *).
    (HasURIError e, MonadError e m) =>
    [Char] -> m URI
    parseAbsoluteURI' [Char]
    s = m URI -> (URI -> m URI) -> Maybe URI -> m URI
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe (e -> m URI
    forall a. e -> m a
    forall e (m :: * -> *) a. MonadError e m => e -> m a
    throwError (e -> m URI) -> e -> m URI
    forall a b. (a -> b) -> a -> b
    $ URIError -> e
    forall e. HasURIError e => URIError -> e
    fromURIError (URIError -> e) -> URIError -> e
    forall a b. (a -> b) -> a -> b
    $ [Char] -> [Char] -> URIError
    URIParseError [Char]
    "parseAbsoluteURI" [Char]
    s) URI -> m URI
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ([Char] -> Maybe URI
    parseAbsoluteURI [Char]
    s)
    parseRelativeReference' :: (HasURIError e, MonadError e m) => String -> m URI
    parseRelativeReference' :: forall e (m :: * -> *).
    (HasURIError e, MonadError e m) =>
    [Char] -> m URI
    parseRelativeReference' [Char]
    s = m URI -> (URI -> m URI) -> Maybe URI -> m URI
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe (e -> m URI
    forall a. e -> m a
    forall e (m :: * -> *) a. MonadError e m => e -> m a
    throwError (e -> m URI) -> e -> m URI
    forall a b. (a -> b) -> a -> b
    $ URIError -> e
    forall e. HasURIError e => URIError -> e
    fromURIError (URIError -> e) -> URIError -> e
    forall a b. (a -> b) -> a -> b
    $ [Char] -> [Char] -> URIError
    URIParseError [Char]
    "parseRelativeReference" [Char]
    s) URI -> m URI
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ([Char] -> Maybe URI
    parseRelativeReference [Char]
    s)

    parseURIUnsafe :: String -> URI
    parseURIUnsafe :: [Char] -> URI
    parseURIUnsafe [Char]
    s = URI -> Maybe URI -> URI
    forall a. a -> Maybe a -> a
    fromMaybe ([Char] -> URI
    forall a. HasCallStack => [Char] -> a
    error ([Char]
    "parseURIUnsafe " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char] -> [Char]
    forall a. Show a => a -> [Char]
    show [Char]
    s)) (Maybe URI -> URI) -> Maybe URI -> URI
    forall a b. (a -> b) -> a -> b
    $ [Char] -> Maybe URI
    parseURIReference [Char]
    s

    --parseAbsoluteURI :: String -> Maybe URI
    --parseRelativeReference :: String -> Maybe URI
    --parseURI :: String -> Maybe URI
    --parseURIReference :: String -> Maybe URI

    data URIError =
        URIParseError String String
      | URIAppendError URI URI
      deriving (URIError -> URIError -> Bool
    (URIError -> URIError -> Bool)
    -> (URIError -> URIError -> Bool) -> Eq URIError
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: URIError -> URIError -> Bool
    == :: URIError -> URIError -> Bool
    $c/= :: URIError -> URIError -> Bool
    /= :: URIError -> URIError -> Bool
    Eq, Eq URIError
    Eq URIError =>
    (URIError -> URIError -> Ordering)
    -> (URIError -> URIError -> Bool)
    -> (URIError -> URIError -> Bool)
    -> (URIError -> URIError -> Bool)
    -> (URIError -> URIError -> Bool)
    -> (URIError -> URIError -> URIError)
    -> (URIError -> URIError -> URIError)
    -> Ord URIError
    URIError -> URIError -> Bool
    URIError -> URIError -> Ordering
    URIError -> URIError -> URIError
    forall a.
    Eq a =>
    (a -> a -> Ordering)
    -> (a -> a -> Bool)
    -> (a -> a -> Bool)
    -> (a -> a -> Bool)
    -> (a -> a -> Bool)
    -> (a -> a -> a)
    -> (a -> a -> a)
    -> Ord a
    $ccompare :: URIError -> URIError -> Ordering
    compare :: URIError -> URIError -> Ordering
    $c< :: URIError -> URIError -> Bool
    < :: URIError -> URIError -> Bool
    $c<= :: URIError -> URIError -> Bool
    <= :: URIError -> URIError -> Bool
    $c> :: URIError -> URIError -> Bool
    > :: URIError -> URIError -> Bool
    $c>= :: URIError -> URIError -> Bool
    >= :: URIError -> URIError -> Bool
    $cmax :: URIError -> URIError -> URIError
    max :: URIError -> URIError -> URIError
    $cmin :: URIError -> URIError -> URIError
    min :: URIError -> URIError -> URIError
    Ord, Int -> URIError -> [Char] -> [Char]
    [URIError] -> [Char] -> [Char]
    URIError -> [Char]
    (Int -> URIError -> [Char] -> [Char])
    -> (URIError -> [Char])
    -> ([URIError] -> [Char] -> [Char])
    -> Show URIError
    forall a.
    (Int -> a -> [Char] -> [Char])
    -> (a -> [Char]) -> ([a] -> [Char] -> [Char]) -> Show a
    $cshowsPrec :: Int -> URIError -> [Char] -> [Char]
    showsPrec :: Int -> URIError -> [Char] -> [Char]
    $cshow :: URIError -> [Char]
    show :: URIError -> [Char]
    $cshowList :: [URIError] -> [Char] -> [Char]
    showList :: [URIError] -> [Char] -> [Char]
    Show)

    -- | Conservative appending of absolute and relative URIs.  There may
    -- be other cases that can be implemented, lets see if they turn up.
    appendURI :: MonadError URIError m => URI -> URI -> m URI
        -- Append the two paths
    appendURI :: forall (m :: * -> *). MonadError URIError m => URI -> URI -> m URI
    appendURI (URI [Char]
    scheme Maybe URIAuth
    auth [Char]
    path1 [Char]
    "" [Char]
    "") (URI [Char]
    "" Maybe URIAuth
    Nothing [Char]
    path2 [Char]
    query [Char]
    fragment) = URI -> m URI
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (URI -> m URI) -> URI -> m URI
    forall a b. (a -> b) -> a -> b
    $ [Char] -> Maybe URIAuth -> [Char] -> [Char] -> [Char] -> URI
    URI [Char]
    scheme Maybe URIAuth
    auth ([Char]
    path1 [Char] -> [Char] -> [Char]
    </> [Char]
    path2) [Char]
    query [Char]
    fragment
        -- Use query from RHS
    appendURI URI
    a URI
    b = URIError -> m URI
    forall a. URIError -> m a
    forall e (m :: * -> *) a. MonadError e m => e -> m a
    throwError (URI -> URI -> URIError
    URIAppendError URI
    a URI
    b)

    -- | Append a list of URI
    -- @@
    -- λ> appendURIs (parseURI "http://host.com") (parseURIRelative "/bar")
    appendURIs :: (Foldable t, MonadError URIError m) => t URI -> m URI
    appendURIs :: forall (t :: * -> *) (m :: * -> *).
    (Foldable t, MonadError URIError m) =>
    t URI -> m URI
    appendURIs t URI
    uris = (URI -> URI -> m URI) -> URI -> t URI -> m URI
    forall (t :: * -> *) (m :: * -> *) a b.
    (Foldable t, Monad m) =>
    (a -> b -> m b) -> b -> t a -> m b
    foldrM URI -> URI -> m URI
    forall (m :: * -> *). MonadError URIError m => URI -> URI -> m URI
    appendURI URI
    nullURI t URI
    uris

    parentURI :: URI -> URI
    parentURI :: URI -> URI
    parentURI URI
    uri = URI
    uri {uriPath = takeDirectory (dropTrailingPathSeparator (uriPath uri))}

    -- properties
    -- appendURIs [x] == x

    prop_append_singleton :: URI -> Bool
    prop_append_singleton :: URI -> Bool
    prop_append_singleton URI
    uri = [URI] -> Either URIError URI
    forall (t :: * -> *) (m :: * -> *).
    (Foldable t, MonadError URIError m) =>
    t URI -> m URI
    appendURIs [URI
    uri] Either URIError URI -> Either URIError URI -> Bool
    forall a. Eq a => a -> a -> Bool
    == URI -> Either URIError URI
    forall a b. b -> Either a b
    Right URI
    uri

    prop_print_parse :: URI -> Bool
    prop_print_parse :: URI -> Bool
    prop_print_parse URI
    uri = [Char] -> Maybe URI
    parseURIReference (URI -> [Char]
    forall a. Show a => a -> [Char]
    show URI
    uri) Maybe URI -> Maybe URI -> Bool
    forall a. Eq a => a -> a -> Bool
    == URI -> Maybe URI
    forall a. a -> Maybe a
    Just URI
    uri

    -- | A wrapper around a String containing a known parsable URI.  Not
    -- absolutely safe, because you could say read "URI' \"bogus string\""
    -- :: URI'.  But enough to save me from myself.
    newtype URI' = URI' String deriving (ReadPrec [URI']
    ReadPrec URI'
    Int -> ReadS URI'
    ReadS [URI']
    (Int -> ReadS URI')
    -> ReadS [URI'] -> ReadPrec URI' -> ReadPrec [URI'] -> Read URI'
    forall a.
    (Int -> ReadS a)
    -> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
    $creadsPrec :: Int -> ReadS URI'
    readsPrec :: Int -> ReadS URI'
    $creadList :: ReadS [URI']
    readList :: ReadS [URI']
    $creadPrec :: ReadPrec URI'
    readPrec :: ReadPrec URI'
    $creadListPrec :: ReadPrec [URI']
    readListPrec :: ReadPrec [URI']
    Read, Int -> URI' -> [Char] -> [Char]
    [URI'] -> [Char] -> [Char]
    URI' -> [Char]
    (Int -> URI' -> [Char] -> [Char])
    -> (URI' -> [Char]) -> ([URI'] -> [Char] -> [Char]) -> Show URI'
    forall a.
    (Int -> a -> [Char] -> [Char])
    -> (a -> [Char]) -> ([a] -> [Char] -> [Char]) -> Show a
    $cshowsPrec :: Int -> URI' -> [Char] -> [Char]
    showsPrec :: Int -> URI' -> [Char] -> [Char]
    $cshow :: URI' -> [Char]
    show :: URI' -> [Char]
    $cshowList :: [URI'] -> [Char] -> [Char]
    showList :: [URI'] -> [Char] -> [Char]
    Show, URI' -> URI' -> Bool
    (URI' -> URI' -> Bool) -> (URI' -> URI' -> Bool) -> Eq URI'
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: URI' -> URI' -> Bool
    == :: URI' -> URI' -> Bool
    $c/= :: URI' -> URI' -> Bool
    /= :: URI' -> URI' -> Bool
    Eq, Eq URI'
    Eq URI' =>
    (URI' -> URI' -> Ordering)
    -> (URI' -> URI' -> Bool)
    -> (URI' -> URI' -> Bool)
    -> (URI' -> URI' -> Bool)
    -> (URI' -> URI' -> Bool)
    -> (URI' -> URI' -> URI')
    -> (URI' -> URI' -> URI')
    -> Ord URI'
    URI' -> URI' -> Bool
    URI' -> URI' -> Ordering
    URI' -> URI' -> URI'
    forall a.
    Eq a =>
    (a -> a -> Ordering)
    -> (a -> a -> Bool)
    -> (a -> a -> Bool)
    -> (a -> a -> Bool)
    -> (a -> a -> Bool)
    -> (a -> a -> a)
    -> (a -> a -> a)
    -> Ord a
    $ccompare :: URI' -> URI' -> Ordering
    compare :: URI' -> URI' -> Ordering
    $c< :: URI' -> URI' -> Bool
    < :: URI' -> URI' -> Bool
    $c<= :: URI' -> URI' -> Bool
    <= :: URI' -> URI' -> Bool
    $c> :: URI' -> URI' -> Bool
    > :: URI' -> URI' -> Bool
    $c>= :: URI' -> URI' -> Bool
    >= :: URI' -> URI' -> Bool
    $cmax :: URI' -> URI' -> URI'
    max :: URI' -> URI' -> URI'
    $cmin :: URI' -> URI' -> URI'
    min :: URI' -> URI' -> URI'
    Ord)

    readURI' :: String -> Maybe URI'
    readURI' :: [Char] -> Maybe URI'
    readURI' [Char]
    s = Maybe URI' -> (URI -> Maybe URI') -> Maybe URI -> Maybe URI'
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe Maybe URI'
    forall a. Maybe a
    Nothing (Maybe URI' -> URI -> Maybe URI'
    forall a b. a -> b -> a
    const (URI' -> Maybe URI'
    forall a. a -> Maybe a
    Just ([Char] -> URI'
    URI' [Char]
    s))) ([Char] -> Maybe URI
    parseURIReference [Char]
    s)

    fromURI' :: URI' -> URI
    fromURI' :: URI' -> URI
    fromURI' (URI' [Char]
    s) = Maybe URI -> URI
    forall a. HasCallStack => Maybe a -> a
    fromJust ([Char] -> Maybe URI
    parseURI [Char]
    s) -- this should provably parse

    -- | Using the bogus Show instance of URI here.  If it ever gets fixed
    -- this will stop working.  Worth noting that show will obscure any
    -- password info embedded in the URI, so that's nice.
    toURI' :: URI -> URI'
    toURI' :: URI -> URI'
    toURI' = [Char] -> URI'
    URI' ([Char] -> URI') -> (URI -> [Char]) -> URI -> URI'
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . URI -> [Char]
    forall a. Show a => a -> [Char]
    show

    uriToString' :: URI -> String
    uriToString' :: URI -> [Char]
    uriToString' URI
    uri = ([Char] -> [Char]) -> URI -> [Char] -> [Char]
    uriToString [Char] -> [Char]
    forall a. a -> a
    id URI
    uri [Char]
    ""

    class HasParseError e where fromParseError :: ParseError -> e
    instance HasParseError ParseError where fromParseError :: ParseError -> ParseError
    fromParseError = ParseError -> ParseError
    forall a. a -> a
    id

    class HasURIError e where fromURIError :: URIError -> e
    instance HasURIError URIError where fromURIError :: URIError -> URIError
    fromURIError = URIError -> URIError
    forall a. a -> a
    id

    instance Ord ParseError where
        compare :: ParseError -> ParseError -> Ordering
    compare ParseError
    a ParseError
    b = [Char] -> [Char] -> Ordering
    forall a. Ord a => a -> a -> Ordering
    compare (ParseError -> [Char]
    forall a. Show a => a -> [Char]
    show ParseError
    a) (ParseError -> [Char]
    forall a. Show a => a -> [Char]
    show ParseError
    b)