-----------------------------------------------------------------------------
--
-- Module      :  Store.RDFstore.HttpCall
--
-- | using http simple to sparql queries and to create requests
-- part of uniform (to use only text
-- wraps URI in URI

-----------------------------------------------------------------------------
--{-# OPTIONS_GHC -F -pgmF htfpp #-}

{-# LANGUAGE FlexibleContexts      #-}
{-# LANGUAGE IncoherentInstances      #-}  -- necessary for overlapping
-- {-# LANGUAGE OverlappingInstances #-} 
{-# LANGUAGE Unsafe #-} 
{-# LANGUAGE FlexibleInstances     #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings     #-}
{-# LANGUAGE ScopedTypeVariables   #-}
{-# LANGUAGE TypeFamilies          #-}
-- {-# LANGUAGE TypeSynonymInstances  #-}
{-# LANGUAGE UndecidableInstances  #-}
{-# LANGUAGE StandaloneDeriving
--    , GeneralizedNewtypeDeriving
    , DeriveGeneric
    , DeriveAnyClass
      #-}
 {-# OPTIONS_GHC -fno-warn-missing-methods #-}

module Uniform.HttpURI (
        -- TimeOutSec, mkTimeOut, mkTimeOutDefault
        -- , URI, HttpQueryParams
    module Uniform.HttpURI
    -- , module Uniform.Zero
    -- , module Uniform.Strings
--    , module N.Network.URI
    -- , uriT
            )  where


import qualified Network.URI as N
-- import  Network.URI (URI(..)) 
-- URI is a newtype with URI as a wrapper
-- import           Uniform.Error (errorT)
import           Uniform.Json
-- import           Uniform.ListForm -- (IsString (..), (</>), (<.>))
-- import           Uniform.Strings 
-- import           Uniform.Strings.Infix ((</>), (<.>))

import           UniformBase
--import qualified   Network.URI.Encode as N2

newtype URI = URI  Text 
    deriving (Int -> URI -> ShowS
[URI] -> ShowS
URI -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [URI] -> ShowS
$cshowList :: [URI] -> ShowS
show :: URI -> String
$cshow :: URI -> String
showsPrec :: Int -> URI -> ShowS
$cshowsPrec :: Int -> URI -> ShowS
Show, ReadPrec [URI]
ReadPrec URI
Int -> ReadS URI
ReadS [URI]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [URI]
$creadListPrec :: ReadPrec [URI]
readPrec :: ReadPrec URI
$creadPrec :: ReadPrec URI
readList :: ReadS [URI]
$creadList :: ReadS [URI]
readsPrec :: Int -> ReadS URI
$creadsPrec :: Int -> ReadS URI
Read, URI -> URI -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: URI -> URI -> Bool
$c/= :: URI -> URI -> Bool
== :: URI -> URI -> Bool
$c== :: URI -> URI -> Bool
Eq, Eq 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
min :: URI -> URI -> URI
$cmin :: URI -> URI -> URI
max :: URI -> URI -> URI
$cmax :: URI -> URI -> URI
>= :: URI -> URI -> Bool
$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
compare :: URI -> URI -> Ordering
$ccompare :: URI -> URI -> Ordering
Ord, forall x. Rep URI x -> URI
forall x. URI -> Rep URI x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep URI x -> URI
$cfrom :: forall x. URI -> Rep URI x
Generic, URI
Eq URI => URI -> Bool
forall z.
z -> (Eq z => z -> Bool) -> (Eq z => z -> Bool) -> Zeros z
notZero :: Eq URI => URI -> Bool
$cnotZero :: Eq URI => URI -> Bool
isZero :: Eq URI => URI -> Bool
$cisZero :: Eq URI => URI -> Bool
zero :: URI
$czero :: URI
Zeros)
    -- do not use the constructor on unchecked inputs
unURI :: URI -> Text
unURI (URI Text
a) = Text
a 
uriT :: URI -> Text
uriT = URI -> Text
unURI  
-- ^ gets the URI as a plain text 
instance ToJSON URI
instance FromJSON URI
instance NiceStrings URI where shownice :: URI -> Text
shownice URI
s = forall a. CharChains a => [a] -> a
unwords' [Text
"URI", URI -> Text
unURI URI
s]

makeURI :: Text -> URI 
makeURI :: Text -> URI
makeURI = Text -> URI
parseURI  
-- make an URI (construct and show as string)

addToURI :: URI -> Text -> URI   -- an url encoded string (use s2url or t2url)
-- add a text at end to an URI
addToURI :: URI -> Text -> URI
addToURI URI
u Text
t = Text -> URI
makeURI forall a b. (a -> b) -> a -> b
$ URI -> Text
uriT URI
u forall a. Semigroup a => a -> a -> a
<> Text
"/" forall a. Semigroup a => a -> a -> a
<> Text
t  -- infix does hide </>
-- less secure but simpler
--              = case (t2,u2) of
--                 (Just t3, Just u3) -> URI . showT $ N.nonStrictRelativeTo t3 u3
--                 _ -> errorT ["addToURI failed u,t", showT u2, showT t2]
        -- where
        --     t2 = N.parseURI . t2s $ t
        --     u2 = N.parseURI . t2s . uriT $ u

-- addToURI2 :: URI -> URL -> URI   -- an url encoded string (use s2url or t2url)
-- -- add a text at end to an URI
-- addToURI2 u t =    --appendOne u t --
--             makeURI $ (uriT u) </> (s2t . unURL $ t)

-- a server URI (not including the port, but absolute)
newtype ServerURI = ServerURI {ServerURI -> URI
unServerURI :: URI}
                deriving (Int -> ServerURI -> ShowS
[ServerURI] -> ShowS
ServerURI -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ServerURI] -> ShowS
$cshowList :: [ServerURI] -> ShowS
show :: ServerURI -> String
$cshow :: ServerURI -> String
showsPrec :: Int -> ServerURI -> ShowS
$cshowsPrec :: Int -> ServerURI -> ShowS
Show, ReadPrec [ServerURI]
ReadPrec ServerURI
Int -> ReadS ServerURI
ReadS [ServerURI]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ServerURI]
$creadListPrec :: ReadPrec [ServerURI]
readPrec :: ReadPrec ServerURI
$creadPrec :: ReadPrec ServerURI
readList :: ReadS [ServerURI]
$creadList :: ReadS [ServerURI]
readsPrec :: Int -> ReadS ServerURI
$creadsPrec :: Int -> ReadS ServerURI
Read, ServerURI -> ServerURI -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ServerURI -> ServerURI -> Bool
$c/= :: ServerURI -> ServerURI -> Bool
== :: ServerURI -> ServerURI -> Bool
$c== :: ServerURI -> ServerURI -> Bool
Eq, Eq ServerURI
ServerURI -> ServerURI -> Bool
ServerURI -> ServerURI -> Ordering
ServerURI -> ServerURI -> ServerURI
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
min :: ServerURI -> ServerURI -> ServerURI
$cmin :: ServerURI -> ServerURI -> ServerURI
max :: ServerURI -> ServerURI -> ServerURI
$cmax :: ServerURI -> ServerURI -> ServerURI
>= :: ServerURI -> ServerURI -> Bool
$c>= :: ServerURI -> ServerURI -> Bool
> :: ServerURI -> ServerURI -> Bool
$c> :: ServerURI -> ServerURI -> Bool
<= :: ServerURI -> ServerURI -> Bool
$c<= :: ServerURI -> ServerURI -> Bool
< :: ServerURI -> ServerURI -> Bool
$c< :: ServerURI -> ServerURI -> Bool
compare :: ServerURI -> ServerURI -> Ordering
$ccompare :: ServerURI -> ServerURI -> Ordering
Ord, forall x. Rep ServerURI x -> ServerURI
forall x. ServerURI -> Rep ServerURI x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ServerURI x -> ServerURI
$cfrom :: forall x. ServerURI -> Rep ServerURI x
Generic, ServerURI
Eq ServerURI => ServerURI -> Bool
forall z.
z -> (Eq z => z -> Bool) -> (Eq z => z -> Bool) -> Zeros z
notZero :: Eq ServerURI => ServerURI -> Bool
$cnotZero :: Eq ServerURI => ServerURI -> Bool
isZero :: Eq ServerURI => ServerURI -> Bool
$cisZero :: Eq ServerURI => ServerURI -> Bool
zero :: ServerURI
$czero :: ServerURI
Zeros, Addr#
NonEmpty ServerURI -> ServerURI
ServerURI -> ServerURI -> ServerURI
forall b. Integral b => b -> ServerURI -> ServerURI
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
forall a. Addr# -> a
noMethodBindingError :: forall a. Addr# -> a
stimes :: forall b. Integral b => b -> ServerURI -> ServerURI
$cstimes :: forall b. Integral b => b -> ServerURI -> ServerURI
sconcat :: NonEmpty ServerURI -> ServerURI
$csconcat :: NonEmpty ServerURI -> ServerURI
$c<> :: ServerURI -> ServerURI -> ServerURI
Semigroup, Semigroup ServerURI
Addr#
ServerURI
[ServerURI] -> ServerURI
ServerURI -> ServerURI -> ServerURI
forall a.
Semigroup a -> a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
forall a. Addr# -> a
noMethodBindingError :: forall a. Addr# -> a
mconcat :: [ServerURI] -> ServerURI
$cmconcat :: [ServerURI] -> ServerURI
mappend :: ServerURI -> ServerURI -> ServerURI
$cmappend :: ServerURI -> ServerURI -> ServerURI
$cmempty :: ServerURI
Monoid
--                        , ListForms
                        )
mkServerURI :: URI -> ServerURI
mkServerURI = URI -> ServerURI
ServerURI 
mkServerURI4text :: Text -> ServerURI
mkServerURI4text = URI -> ServerURI
ServerURI  forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> URI
makeURI

-- --deriving  -- <> and mempty missing for Semigroup

-- instance ToJSON ServerURI 
-- instance Read N.URI where 

-- instance Zeros N.URI where zero = N.nullURI -- fromJustNote "zero mk URI" $ mkURI ""
-- deriving instance Read URI 
-- deriving instance Read (RText l)
-- instance ToJSON URI 
-- instance FromJSON URI

-- -- instance ToJSON N.URI
-- -- instance ToJSON N.URI  -- not possible, issue Auth
-- -- instance ToJSON N.URIAuth

-- -- deriving instance Generic N.URIAuth 

-- -- instance (Zeros ServerURI, Zeros (LF ServerURI)) => ListForms ServerURI
-- --     where
-- --     type LF ServerURI = Text
-- --     mkOne = mkServerURI  -- = ServerURI . makeAbsURI
-- --     appendTwo a b = ServerURI $ appendTwo (unServerURI a)  (unServerURI b)

-- --instance ListForms URI where
-- --    type LF URI = Text
-- --    mkOne = makeURI
-- --    appendTwo a b = makeURI $ appendTwo  (showT a) (showT b)

-- mkServerURI :: Text -> ServerURI        -- useful, because it is typed!
-- mkServerURI = ServerURI . makeURI  -- check for absolute uri?

-- | a type for the application path when calling Http
-- after the URI till the ? (starts with /)
newtype HttpPath = HttpPath Text
    deriving (Int -> HttpPath -> ShowS
[HttpPath] -> ShowS
HttpPath -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [HttpPath] -> ShowS
$cshowList :: [HttpPath] -> ShowS
show :: HttpPath -> String
$cshow :: HttpPath -> String
showsPrec :: Int -> HttpPath -> ShowS
$cshowsPrec :: Int -> HttpPath -> ShowS
Show, ReadPrec [HttpPath]
ReadPrec HttpPath
Int -> ReadS HttpPath
ReadS [HttpPath]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [HttpPath]
$creadListPrec :: ReadPrec [HttpPath]
readPrec :: ReadPrec HttpPath
$creadPrec :: ReadPrec HttpPath
readList :: ReadS [HttpPath]
$creadList :: ReadS [HttpPath]
readsPrec :: Int -> ReadS HttpPath
$creadsPrec :: Int -> ReadS HttpPath
Read, HttpPath -> HttpPath -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: HttpPath -> HttpPath -> Bool
$c/= :: HttpPath -> HttpPath -> Bool
== :: HttpPath -> HttpPath -> Bool
$c== :: HttpPath -> HttpPath -> Bool
Eq, Eq HttpPath
HttpPath -> HttpPath -> Bool
HttpPath -> HttpPath -> Ordering
HttpPath -> HttpPath -> HttpPath
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
min :: HttpPath -> HttpPath -> HttpPath
$cmin :: HttpPath -> HttpPath -> HttpPath
max :: HttpPath -> HttpPath -> HttpPath
$cmax :: HttpPath -> HttpPath -> HttpPath
>= :: HttpPath -> HttpPath -> Bool
$c>= :: HttpPath -> HttpPath -> Bool
> :: HttpPath -> HttpPath -> Bool
$c> :: HttpPath -> HttpPath -> Bool
<= :: HttpPath -> HttpPath -> Bool
$c<= :: HttpPath -> HttpPath -> Bool
< :: HttpPath -> HttpPath -> Bool
$c< :: HttpPath -> HttpPath -> Bool
compare :: HttpPath -> HttpPath -> Ordering
$ccompare :: HttpPath -> HttpPath -> Ordering
Ord, forall x. Rep HttpPath x -> HttpPath
forall x. HttpPath -> Rep HttpPath x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep HttpPath x -> HttpPath
$cfrom :: forall x. HttpPath -> Rep HttpPath x
Generic, HttpPath
Eq HttpPath => HttpPath -> Bool
forall z.
z -> (Eq z => z -> Bool) -> (Eq z => z -> Bool) -> Zeros z
notZero :: Eq HttpPath => HttpPath -> Bool
$cnotZero :: Eq HttpPath => HttpPath -> Bool
isZero :: Eq HttpPath => HttpPath -> Bool
$cisZero :: Eq HttpPath => HttpPath -> Bool
zero :: HttpPath
$czero :: HttpPath
Zeros)
mkHttpPath :: Text -> HttpPath
mkHttpPath :: Text -> HttpPath
mkHttpPath = Text -> HttpPath
HttpPath    -- could check for acceptance here?


-- | the type for the paramter key - value pairs, comes after the ?
unHttpQueryParams :: HttpQueryParams -> [(Text, Maybe Text)]
mkHttpQueryParams :: [(Text, Maybe Text)] -> HttpQueryParams
newtype HttpQueryParams = HttpQueryParams [(Text, Maybe Text)]
    deriving (Int -> HttpQueryParams -> ShowS
[HttpQueryParams] -> ShowS
HttpQueryParams -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [HttpQueryParams] -> ShowS
$cshowList :: [HttpQueryParams] -> ShowS
show :: HttpQueryParams -> String
$cshow :: HttpQueryParams -> String
showsPrec :: Int -> HttpQueryParams -> ShowS
$cshowsPrec :: Int -> HttpQueryParams -> ShowS
Show, ReadPrec [HttpQueryParams]
ReadPrec HttpQueryParams
Int -> ReadS HttpQueryParams
ReadS [HttpQueryParams]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [HttpQueryParams]
$creadListPrec :: ReadPrec [HttpQueryParams]
readPrec :: ReadPrec HttpQueryParams
$creadPrec :: ReadPrec HttpQueryParams
readList :: ReadS [HttpQueryParams]
$creadList :: ReadS [HttpQueryParams]
readsPrec :: Int -> ReadS HttpQueryParams
$creadsPrec :: Int -> ReadS HttpQueryParams
Read, HttpQueryParams -> HttpQueryParams -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: HttpQueryParams -> HttpQueryParams -> Bool
$c/= :: HttpQueryParams -> HttpQueryParams -> Bool
== :: HttpQueryParams -> HttpQueryParams -> Bool
$c== :: HttpQueryParams -> HttpQueryParams -> Bool
Eq, forall x. Rep HttpQueryParams x -> HttpQueryParams
forall x. HttpQueryParams -> Rep HttpQueryParams x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep HttpQueryParams x -> HttpQueryParams
$cfrom :: forall x. HttpQueryParams -> Rep HttpQueryParams x
Generic, HttpQueryParams
Eq HttpQueryParams => HttpQueryParams -> Bool
forall z.
z -> (Eq z => z -> Bool) -> (Eq z => z -> Bool) -> Zeros z
notZero :: Eq HttpQueryParams => HttpQueryParams -> Bool
$cnotZero :: Eq HttpQueryParams => HttpQueryParams -> Bool
isZero :: Eq HttpQueryParams => HttpQueryParams -> Bool
$cisZero :: Eq HttpQueryParams => HttpQueryParams -> Bool
zero :: HttpQueryParams
$czero :: HttpQueryParams
Zeros, Addr#
NonEmpty HttpQueryParams -> HttpQueryParams
HttpQueryParams -> HttpQueryParams -> HttpQueryParams
forall b. Integral b => b -> HttpQueryParams -> HttpQueryParams
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
forall a. Addr# -> a
noMethodBindingError :: forall a. Addr# -> a
stimes :: forall b. Integral b => b -> HttpQueryParams -> HttpQueryParams
$cstimes :: forall b. Integral b => b -> HttpQueryParams -> HttpQueryParams
sconcat :: NonEmpty HttpQueryParams -> HttpQueryParams
$csconcat :: NonEmpty HttpQueryParams -> HttpQueryParams
$c<> :: HttpQueryParams -> HttpQueryParams -> HttpQueryParams
Semigroup, Semigroup HttpQueryParams
Addr#
HttpQueryParams
[HttpQueryParams] -> HttpQueryParams
HttpQueryParams -> HttpQueryParams -> HttpQueryParams
forall a.
Semigroup a -> a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
forall a. Addr# -> a
noMethodBindingError :: forall a. Addr# -> a
mconcat :: [HttpQueryParams] -> HttpQueryParams
$cmconcat :: [HttpQueryParams] -> HttpQueryParams
mappend :: HttpQueryParams -> HttpQueryParams -> HttpQueryParams
$cmappend :: HttpQueryParams -> HttpQueryParams -> HttpQueryParams
$cmempty :: HttpQueryParams
Monoid)
unHttpQueryParams :: HttpQueryParams -> [(Text, Maybe Text)]
unHttpQueryParams (HttpQueryParams [(Text, Maybe Text)]
p) = [(Text, Maybe Text)]
p
mkHttpQueryParams :: [(Text, Maybe Text)] -> HttpQueryParams
mkHttpQueryParams = [(Text, Maybe Text)] -> HttpQueryParams
HttpQueryParams
--instance Zeros HttpQueryParams where zero = HttpQueryParams []
-- unclear why automatic derivation does not work

-- instance   ListForms HttpQueryParams where
--         type LF HttpQueryParams = (Text, Maybe Text)
--         mkOne a = HttpQueryParams [a]
--         appendTwo = (<>)


-- combineHttpQueryParams :: HttpQueryParams -> HttpQueryParams -> HttpQueryParams
-- combineHttpQueryParams p1 p2 = p1 <> p2
-- --    HttpQueryParams (p11 ++ p22)
-- --        where   p11 = unHttpQueryParams p1
-- --                p22 = unHttpQueryParams p2

-- -- newtype URI = URI N.URI  deriving (Eq, Ord, Generic,   Semigroup, Monoid)
-- -- show and read is separately instantiated
-- -- zeros not available for N.URI

-- -- un2 (URI u) = u   -- to remove the newtype level
-- -- instance Zeros URI where
--     -- zero = makeURI "http://zero.zero"  -- there is no obvious zero here
-- -- instance FromJSON N.URI
-- -- instance FromJSON N.URIAuth

-- -- instance ListForms URI where
-- --     type LF URI = Text
-- --     mkOne = makeURI  -- do not test here for validity, because it is used for appendTwo
-- --     appendTwo a b = makeURI $ appendTwo  (uriT a) (uriT b)

parseURI :: Text ->  URI
-- reads a text string, checks for URI conformity 
-- and renders as text wrapped in URI 
-- if this is the only way to convert a text to an URI
-- they must be always save 
parseURI :: Text -> URI
parseURI Text
u = Text -> URI
URI forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {a}. Show a => a -> Text
showT forall a b. (a -> b) -> a -> b
$  forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall a. [Text] -> a
errorT [Text
"parseURI in Uniform.HttpURI not acceptable string \n", Text
u, Text
"END of string"])
                forall a. a -> a
id
                (String -> Maybe URI
N.parseURI  forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
t2s forall a b. (a -> b) -> a -> b
$ Text
u )
--                fmap URI . N.parseURI . t2s $ t

-- -- parseAbsoluteURI :: Text -> Maybe URI
-- -- parseAbsoluteURI u = maybe (errorT ["parseAbsoluteURI in Uniform.HttpURI not acceptable string \n", u, "END of string"])
-- --                 (Just . URI)
-- --                 (N.parseAbsoluteURI  . t2s $ u )
-- -- --                fmap URI . N.parseAbsoluteURI . t2s $ t

makeAbsURI :: Text -> URI
makeAbsURI :: Text -> URI
makeAbsURI = Text -> URI
makeURI  -- leave if later a differentiation is desired
-- -- makeAbsURI u = -- error "absfr"
-- --     fromMaybe (errorT ["makeAbsURI in Uniform.HttpURI not acceptable string \n", u, "END of string"])
-- --                             (parseAbsoluteURI  u :: Maybe URI)
-- -- --    URI $ maybe (errorT ["makeAbsURI in Uniform.HttpURI", u])
-- -- --                id
-- -- --                (N.parseAbsoluteURI . t2s   $ u)
-- makeURI :: Text -> URI
-- -- makeURI u = -- error "sdafsfs"
-- --     fromMaybe (errorT ["makeURI in Uniform.HttpURI not acceptable string \n", u, "END of string"])
-- --                 (parseURI  u :: Maybe URI)
-- -- -- alternative code: makeURI2 = fromMaybe zero . parseURI

-- makeURI u = fromJustNote "makeURI" $ mkURI u 
-- uriT = showT 

-- addToURI :: URI -> Text -> URI   -- an url encoded string (use s2url or t2url)
-- -- add a text at end to an URI
-- addToURI u t =    --appendOne u t --
--             makeURI $ (uriT u) </> (s2t . unURL . s2url . t2s $  t)

-- addToURI2 :: URI -> URL -> URI   -- an url encoded string (use s2url or t2url)
-- -- add a text at end to an URI
-- addToURI2 u t =    --appendOne u t --
--             makeURI $ (uriT u) </> (s2t . unURL $ t)

newtype PortNumber = PortNumber Int
    deriving (PortNumber -> PortNumber -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PortNumber -> PortNumber -> Bool
$c/= :: PortNumber -> PortNumber -> Bool
== :: PortNumber -> PortNumber -> Bool
$c== :: PortNumber -> PortNumber -> Bool
Eq, Eq PortNumber
PortNumber -> PortNumber -> Bool
PortNumber -> PortNumber -> Ordering
PortNumber -> PortNumber -> PortNumber
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
min :: PortNumber -> PortNumber -> PortNumber
$cmin :: PortNumber -> PortNumber -> PortNumber
max :: PortNumber -> PortNumber -> PortNumber
$cmax :: PortNumber -> PortNumber -> PortNumber
>= :: PortNumber -> PortNumber -> Bool
$c>= :: PortNumber -> PortNumber -> Bool
> :: PortNumber -> PortNumber -> Bool
$c> :: PortNumber -> PortNumber -> Bool
<= :: PortNumber -> PortNumber -> Bool
$c<= :: PortNumber -> PortNumber -> Bool
< :: PortNumber -> PortNumber -> Bool
$c< :: PortNumber -> PortNumber -> Bool
compare :: PortNumber -> PortNumber -> Ordering
$ccompare :: PortNumber -> PortNumber -> Ordering
Ord, Int -> PortNumber -> ShowS
[PortNumber] -> ShowS
PortNumber -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PortNumber] -> ShowS
$cshowList :: [PortNumber] -> ShowS
show :: PortNumber -> String
$cshow :: PortNumber -> String
showsPrec :: Int -> PortNumber -> ShowS
$cshowsPrec :: Int -> PortNumber -> ShowS
Show, ReadPrec [PortNumber]
ReadPrec PortNumber
Int -> ReadS PortNumber
ReadS [PortNumber]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [PortNumber]
$creadListPrec :: ReadPrec [PortNumber]
readPrec :: ReadPrec PortNumber
$creadPrec :: ReadPrec PortNumber
readList :: ReadS [PortNumber]
$creadList :: ReadS [PortNumber]
readsPrec :: Int -> ReadS PortNumber
$creadsPrec :: Int -> ReadS PortNumber
Read, forall x. Rep PortNumber x -> PortNumber
forall x. PortNumber -> Rep PortNumber x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep PortNumber x -> PortNumber
$cfrom :: forall x. PortNumber -> Rep PortNumber x
Generic, PortNumber
Eq PortNumber => PortNumber -> Bool
forall z.
z -> (Eq z => z -> Bool) -> (Eq z => z -> Bool) -> Zeros z
notZero :: Eq PortNumber => PortNumber -> Bool
$cnotZero :: Eq PortNumber => PortNumber -> Bool
isZero :: Eq PortNumber => PortNumber -> Bool
$cisZero :: Eq PortNumber => PortNumber -> Bool
zero :: PortNumber
$czero :: PortNumber
Zeros)
mkPortNumber :: Int -> PortNumber
mkPortNumber Int
i = if Int
i forall a. Ord a => a -> a -> Bool
> Int
0 Bool -> Bool -> Bool
&& Int
i forall a. Ord a => a -> a -> Bool
< Int
64000 then  Int -> PortNumber
PortNumber Int
i
                    else forall a. [Text] -> a
errorT [Text
"PortNumber out of range", forall {a}. Show a => a -> Text
showT Int
i]
unPortNumber :: PortNumber -> Int
unPortNumber (PortNumber Int
i) = Int
i

addPort2ServerURI :: ServerURI -> PortNumber -> ServerURI
-- addPort2ServerURI u p = mkOne $ appendTwo  (uriT . unServerURI $ u)
--             (":" <> (showT . unPortNumber $ p))
addPort2ServerURI :: ServerURI -> PortNumber -> ServerURI
addPort2ServerURI (ServerURI URI
u) (PortNumber Int
i) = URI -> ServerURI
mkServerURI (Text -> URI
makeURI forall a b. (a -> b) -> a -> b
$ URI -> Text
uriT URI
u Text -> Text -> Text
<:> forall {a}. Show a => a -> Text
showT Int
i)

-- -- uriT :: URI -> Text
-- -- -- ^ convert an uri to a text (but not a show instance with "")
-- -- uriT = s2t . uriS

-- -- uriS :: URI -> String
-- -- uriS u =  N.uriToString defaultUserInfoMap (un2 u) $ ""
-- -- -- to filter out the password, if any in a URI

-- -- -- copied
-- -- defaultUserInfoMap :: String -> String
-- -- defaultUserInfoMap uinf = user ++ newpass
-- --     where
-- --         (user,pass) = break (==':') uinf
-- --         newpass     = if null pass || (pass == "@")
-- --                                    || (pass == ":@")
-- --                         then pass
-- --                         else ":...@"

-- -- deriving instance Show URI 
-- -- deriving instance Read URI
-- -- deriving instance Read N.URI 
-- -- deriving instance Read N.URIAuth 
-- -- deriving instance {-# Overlapping #-} Show N.URI 
-- --                 -- the defined in N are not regular Show !!
-- -- deriving instance {-# Overlapping #-} Show N.URIAuth 

-- -- instance IsString URI where
-- --     fromString = read . show

-- -- -- instance Show URI where
-- -- --     showsPrec _ s s2 = (show $ uriS s )++ s2

-- -- -- instance Read URI where
-- -- --         readsPrec i r =  maybe []  (\res -> [(URI res, rem1)] ) $ N.parseURI x
-- -- --                 where  [(x ::String , rem1)] = readsPrec i r