fcmtp-data/src/Data/SMTP/Types/URI.hs

{-# LANGUAGE OverloadedStrings #-}

module Data.SMTP.Types.URI where

import qualified Network.URI as N
import Data.SMTP.Account
import Data.List

import Text.StringConvert

newtype Path = Path [String] deriving (Eq, Ord, Read, Show)
newtype Revision = Revision String deriving (Eq, Ord, Read, Show)
data Parameter = Parameter String String deriving (Eq, Ord, Read, Show)

data URI = URI {account :: Account, path :: Path, revision :: Maybe Revision, parameters :: [Parameter]} 
         deriving (Eq, Ord, Read)

fullPath :: URI -> String
fullPath URI{path=Path p} = intercalate "/" $ map uriEncode p

fullURI :: URI -> String
fullURI u@(URI{account=a, revision=r, parameters=pp}) =
  concat $ ["FCMTP://", s . fullAccount $ a, fullPath u] ++ (
    case r of
      Nothing -> []
      Just (Revision r') -> [":", r']
    ) ++ (
    if null pp
    then []
    else ["?", intercalate "&" $ map formatParameter pp]
    )
  where
    formatParameter (Parameter nm vl) = concat [uriEncode nm, "=", uriEncode vl]

uriEncode = N.escapeURIString N.isUnescapedInURIComponent
    
instance Show URI where
  show = fullURI