module Network.LongURL 
    ( CurlInstance(..)
    , longURL
    , SupportedSite(..)
    , supportedSites
    , URLInfo(..)
    ) where

import Network.Curl (Curl, CurlResponse(..), do_curl, method_GET)
import Network.Curl.Code (CurlCode(..))
import Network.Curl.Opts (CurlOption(..))
import Network.Curl.Types (URLString)
import Text.JSON.String (readJSObject, runGetJSON)
import Text.JSON.Types (fromJSObject, fromJSString, JSObject, JSValue(..))
import Util.Codec.Percent (getEncodedString)

import Control.Applicative ((<$>))

data CurlInstance = CurlInstance { curl :: Curl
                                 , userAgent :: String
                                 }

data SupportedSite = SupportedSite { siteName :: String
                                   , domains :: [String]
                                   }

data URLInfo = URLInfo { longURL' :: String
                       , pageTitle :: Maybe String
                       }

simple_get :: CurlInstance -> URLString -> IO String
simple_get ci url = handleResponse =<< do_curl (curl ci) url
                    (CurlUserAgent (userAgent ci) : CurlVerbose False : CurlNoProgress True : method_GET)
    where
      handleResponse :: CurlResponse -> IO String
      handleResponse r = do { (CurlResponse { respCurlCode = CurlOK, respBody = b }) <- return r; return b }

getJSArray :: Monad m => JSValue -> m [JSValue]
getJSArray v = do { (JSArray a) <- return v; return a }

getJSString :: Monad m => JSValue -> m String
getJSString v = do { (JSString jss) <- return v; return $ fromJSString jss }

apiSite :: String
apiSite = "http://api.longurl.org"

apiVersion :: String
apiVersion = "v1"

-- | Makes a call to the JSON web API
apiCall :: CurlInstance -> String -> IO [(String, JSValue)]
apiCall ci query = do
  (Right (JSObject jso)) <- (runGetJSON readJSObject <$>) . simple_get ci
                            $ apiSite ++ "/" ++ apiVersion ++ "/" ++ query
  return $ fromJSObject jso

supportedSites :: CurlInstance -> IO [SupportedSite]
supportedSites ci =
    mapM (\(n, ds) -> SupportedSite n <$> (mapM getJSString =<< getJSArray ds)) =<< apiCall ci "services?format=json"

longURL :: CurlInstance -> String -> IO URLInfo
longURL ci url = do
  rec <- apiCall ci $ "expand?url=" ++ getEncodedString url ++ "&format=json"
  (Just jsURL) <- return $ lookup "long_url" rec
  url' <- getJSString jsURL
  title <- maybe (return Nothing) ((return <$>) . getJSString) $ lookup "title" rec
  return $ URLInfo { longURL' = url', pageTitle = title }

instance Show URLInfo where
    show (URLInfo { longURL' = url', pageTitle = Nothing })    = url'
    show (URLInfo { longURL' = url', pageTitle = Just title }) = url' ++ " [\"" ++ title ++ "\"]"