ResourcePath.hs

-- | Module implementing plumbing to get a unified path locator,
-- handling URI & local path. Implement the 'GraphPath' and 'GraphWalker'
-- typeclass with 'HxtNode'
module Text.Webrexp.ResourcePath 
    ( ResourcePath (..)
    , rezPathToString
    , downloadBinary
    ) where

import Text.Webrexp.GraphWalker
import Control.Applicative
import Control.Monad.IO.Class
import Data.Maybe
import Network.HTTP
import Network.Browser
import Network.URI
import System.Directory
import System.FilePath
import qualified Text.Webrexp.ProjectByteString as B

import Text.Webrexp.Remote.MimeTypes

-- | Main data type
data ResourcePath =
    -- | Represent a file stored on the hard-drive of this
    -- machine.
      Local FilePath
    -- | Represent a ressource spread on internet.
    | Remote URI
    deriving (Eq, Show)

instance GraphPath ResourcePath where
    (<//>) = combinePath
    importPath = toRezPath
    dumpDataAtPath = dumpResourcePath 
    localizePath = extractFileName

-- | Given a ressource, transforme it to a string
-- representation. This function should be used instead
-- of the 'Show' instance, which is aimed at debugging
-- only.
rezPathToString :: ResourcePath -> String
rezPathToString (Local p) = p
rezPathToString (Remote uri) = show uri

toRezPath :: String -> Maybe ResourcePath
toRezPath s = case (parseURI s, isValid s, isRelativeReference s) of
        (Just u, _, _) -> Just $ Remote u
        (Nothing, True, _) -> Just . Local $ normalise s
        (Nothing, False, True) -> Remote <$> parseRelativeReference s
        (Nothing, False, False) -> Nothing

-- | Resource path combiner, similar to </> in use,
-- but also handle URI.
combinePath :: ResourcePath -> ResourcePath -> ResourcePath
combinePath (Local a) (Local b) = Local . normalise $ dropFileName a </> b
combinePath (Remote a) (Remote b) =
    case b `relativeTo` a of
         -- TODO : find another way for this
         Nothing -> error "Can't merge resourcepath" 
                   -- Remote a
         Just c -> Remote c

combinePath (Remote a) (Local b)
    | isRelativeReference b = case parseRelativeReference b of
        Just r -> Remote . fromJust $ r `relativeTo` a
        Nothing -> error "Not possible, checked before"
combinePath (Local _) b@(Remote _) = b
combinePath _ _ = error "Mixing local/remote path"

extractFileName :: ResourcePath -> String
extractFileName (Remote a) = snd . splitFileName $ uriPath a
extractFileName (Local c) = snd $ splitFileName c

dumpResourcePath :: (Monad m, MonadIO m)
                 => Loggers -> ResourcePath -> m ()
dumpResourcePath _ src@(Local source) = do
    cwd <- liftIO getCurrentDirectory
    liftIO . copyFile source $ cwd </> extractFileName src

dumpResourcePath loggers@(logger,_,_) p@(Remote a) = do
  (_, rsp) <- downloadBinary loggers a
  let rawFilename = extractFileName p
      filename = case retrieveHeaders HdrContentType rsp of
         [] -> rawFilename 
         (hdr:_) -> addContentTypeExtension
                            (hdrValue hdr) rawFilename
                 

  liftIO . logger $ "Downloading '" ++ show a ++ "' in '" ++ filename
  liftIO . B.writeFile filename $ rspBody rsp

-- | Helper function to grab a resource on internet and returning
-- it's binary representation, and it's real place if any.
downloadBinary :: (Monad m, MonadIO m)
               => Loggers -> URI -> m (URI, Response B.ByteString)
downloadBinary (_, errLog, verbose) url =
    liftIO . browse $ do
        setAllowRedirects True
        setErrHandler errLog
        setOutHandler verbose
        request $ defaultGETRequest_ url