-----------------------------------------------------------------------------
--
-- Module      :  files for Http 
--
-- | 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 DeriveGeneric  #-}
-- {-# LANGUAGE StandaloneDeriving
-- --    , GeneralizedNewtypeDeriving
--     , DeriveGeneric
--     , DeriveAnyClass
--       #-}
 {-# OPTIONS_GHC -fno-warn-missing-methods #-}

module Uniform.HttpFiles (
        -- TimeOutSec, mkTimeOut, mkTimeOutDefault
        -- , URI, HttpQueryParams
    module Uniform.HttpFiles
    -- , module Uniform.Zero
    -- , module Uniform.FileIO
--    , 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           UniformBase

import           Uniform.Json
--import qualified   Network.URI.Encode as N2

-------------------------------------------------------HTML files
extHTML :: Extension
extHTML :: Extension
extHTML = FilePath -> Extension
Extension FilePath
"html"

newtype HTMLout = HTMLout {HTMLout -> Text
contentHtml :: Text}
    deriving (Int -> HTMLout -> ShowS
[HTMLout] -> ShowS
HTMLout -> FilePath
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [HTMLout] -> ShowS
$cshowList :: [HTMLout] -> ShowS
show :: HTMLout -> FilePath
$cshow :: HTMLout -> FilePath
showsPrec :: Int -> HTMLout -> ShowS
$cshowsPrec :: Int -> HTMLout -> ShowS
Show, ReadPrec [HTMLout]
ReadPrec HTMLout
Int -> ReadS HTMLout
ReadS [HTMLout]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [HTMLout]
$creadListPrec :: ReadPrec [HTMLout]
readPrec :: ReadPrec HTMLout
$creadPrec :: ReadPrec HTMLout
readList :: ReadS [HTMLout]
$creadList :: ReadS [HTMLout]
readsPrec :: Int -> ReadS HTMLout
$creadsPrec :: Int -> ReadS HTMLout
Read, HTMLout -> HTMLout -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: HTMLout -> HTMLout -> Bool
$c/= :: HTMLout -> HTMLout -> Bool
== :: HTMLout -> HTMLout -> Bool
$c== :: HTMLout -> HTMLout -> Bool
Eq, Eq HTMLout
HTMLout -> HTMLout -> Bool
HTMLout -> HTMLout -> Ordering
HTMLout -> HTMLout -> HTMLout
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 :: HTMLout -> HTMLout -> HTMLout
$cmin :: HTMLout -> HTMLout -> HTMLout
max :: HTMLout -> HTMLout -> HTMLout
$cmax :: HTMLout -> HTMLout -> HTMLout
>= :: HTMLout -> HTMLout -> Bool
$c>= :: HTMLout -> HTMLout -> Bool
> :: HTMLout -> HTMLout -> Bool
$c> :: HTMLout -> HTMLout -> Bool
<= :: HTMLout -> HTMLout -> Bool
$c<= :: HTMLout -> HTMLout -> Bool
< :: HTMLout -> HTMLout -> Bool
$c< :: HTMLout -> HTMLout -> Bool
compare :: HTMLout -> HTMLout -> Ordering
$ccompare :: HTMLout -> HTMLout -> Ordering
Ord, forall x. Rep HTMLout x -> HTMLout
forall x. HTMLout -> Rep HTMLout x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep HTMLout x -> HTMLout
$cfrom :: forall x. HTMLout -> Rep HTMLout x
Generic)

instance ToJSON HTMLout

-- a wrapper around html ready to publish
unHTMLout :: HTMLout -> Text
unHTMLout (HTMLout Text
a) = Text
a

htmloutFileType :: TypedFile5 Text HTMLout
htmloutFileType = TypedFile5{tpext5 :: Extension
tpext5 = Extension
extHTML} :: TypedFile5 Text HTMLout

instance Zeros HTMLout where
    zero :: HTMLout
zero = Text -> HTMLout
HTMLout forall z. Zeros z => z
zero

instance TypedFiles7 Text HTMLout where
    wrap7 :: Text -> HTMLout
wrap7 = Text -> HTMLout
HTMLout
    unwrap7 :: HTMLout -> Text
unwrap7 (HTMLout Text
a) = Text
a

-- extension in metapage