{-# LANGUAGE TypeSynonymInstances, DeriveDataTypeable #-}

module HAppS.Server.SURI where
import Data.Maybe
import Data.Generics
import HAppS.Util.Common(mapFst)
import qualified Network.URI as URI

path, query, scheme :: SURI -> String
path  = URI.uriPath . suri
query  = URI.uriQuery . suri
scheme  = URI.uriScheme . suri

u_scheme, u_path :: (String -> String) -> SURI -> SURI
u_scheme f (SURI u) = SURI (u {URI.uriScheme=f $ URI.uriScheme u})
u_path f (SURI u) = SURI $ u {URI.uriPath=f $ URI.uriPath u}
a_scheme, a_path :: String -> SURI -> SURI
a_scheme a (SURI u) = SURI $ u {URI.uriScheme=a}
a_path a (SURI u) = SURI $ u {URI.uriPath=a}

escape, unEscape :: String -> String
unEscape = URI.unEscapeString . map (\x->if x=='+' then ' ' else x)
escape = URI.escapeURIString URI.isAllowedInURI

isAbs :: SURI -> Bool
isAbs = not . null . URI.uriScheme . suri
--isAbs = maybe True ( mbParsed

newtype SURI = SURI {suri::URI.URI} deriving (Eq,Data,Typeable)
instance Show SURI where
    showsPrec d (SURI uri) = showsPrec d $ show uri
instance Read SURI where
    readsPrec d = mapFst fromJust .  filter (isJust . fst) . mapFst parse . readsPrec d 

instance Ord SURI where
    compare a b = show a `compare` show b

--parse  = fmap SURI . URI.parseURIReference ::String->Maybe SURI

-- | Render should be used for prettyprinting URIs.
render :: (ToSURI a) => a -> String
render x = (show . suri . toSURI) x
parse :: String -> Maybe SURI
parse =  fmap SURI . URI.parseURIReference 


class ToSURI x where toSURI::x->SURI
instance ToSURI SURI where toSURI=id
instance ToSURI URI.URI where toSURI=SURI
instance ToSURI String where 
    toSURI = maybe (SURI $ URI.URI "" Nothing "" "" "") id . parse


--handling obtaining things from URI paths
class FromPath x where fromPath::String->x
