module Hoovie.Messages (
        BrowseType(..),
        hoovieXml,
        browseResponse,
        contentDirectoryEvent,
        connectionManagerEvent
    ) where

import Text.XML.Light   (QName(..), CData(..), CDataKind(..), Content(..), Element(..), Attr(..), showContent)
import Data.Time.Format (formatTime)
import System.Locale    (defaultTimeLocale)
import Text.Printf      (printf)
import Data.Time        (UTCTime(..), fromGregorian, secondsToDiffTime)
import Data.List        (sortBy)
import Data.Ord         (comparing)

import qualified Data.ByteString       as B
import qualified Data.ByteString.Char8 as BC

import Hoovie.Resource

-- some helpers
infixr 9 !
(!) :: String -> String -> QName
"" ! name = QName name Nothing Nothing
ns ! name = QName name Nothing (Just ns)

infixr 8 ~=
(~=) :: QName -> String -> Attr
name ~= value = Attr name value

tag :: QName -> [Attr] -> [Content] -> Content
tag n as cs = Elem $ Element n as cs Nothing

text :: String -> [Content]
text s = [Text (CData CDataText s Nothing)]

xmlHeader :: B.ByteString
xmlHeader = BC.pack "<?xml version=\"1.0\" encoding=\"utf-8\"?>"

asString :: Content -> B.ByteString
asString x = xmlHeader `B.append` (BC.pack $ showContent x)

envelope :: Content -> Content
envelope xs = 
    tag ("s"!"Envelope") ["xmlns"!"s" ~= "http://schemas.xmlsoap.org/soap/envelope/", "s"!"encodingStyle" ~= "http://schemas.xmlsoap.org/soap/encoding/"] [
        tag ("s"!"Body") [] [xs]
    ]

-- actual messages
hoovieXml :: String -> String -> String -> B.ByteString
hoovieXml url uuid pngUri = asString $
    tag (""!"root") ["xmlns"!"dlna" ~= "urn:schemas-dlna-org:device-1-0", ""!"xmlns" ~= "urn:schemas-upnp-org:device-1-0"] [
        tag (""!"specVersion") [] [
            tag (""!"major") [] $ text "1",
            tag (""!"minor") [] $ text "0"
        ],
        tag (""!"URLBase") [] $ text url,
        tag (""!"device") [] [
            tag ("dlna"!"X_DLNADOC")    ["xmlns"!"dlna" ~= "urn:schemas-dlna-org:device-1-0"] $ text "DMS-1.50",
            tag ("dlna"!"X_DLNADOC")    ["xmlns"!"dlna" ~= "urn:schemas-dlna-org:device-1-0"] $ text "M-DMS-1.50",
            tag (""!"deviceType")       [] $ text "urn:schemas-upnp-org:device:MediaServer:1",
            tag (""!"friendlyName")     [] $ text "Hoovie",
            tag (""!"manufacturer")     [] $ text "hoovie.org",
            tag (""!"manufacturerURL")  [] $ text "http://www.hoovie.org",
            tag (""!"modelDescription") [] $ text "Hoovie - The Haskell Media Server",
            tag (""!"modelName")        [] $ text "Hoovie",
            tag (""!"modelNumber")      [] $ text "01",
            tag (""!"modelURL")         [] $ text "http://www.hoovie.org",
            tag (""!"serialNumber")     [] $ text "",
            tag (""!"UPC")              [] $ text "",
            tag (""!"UDN")              [] $ text ("uuid:" ++ uuid),
            tag (""!"presentationURL")  [] $ text (url ++ "/index.html"),
            tag (""!"iconList") [] [
                tag (""!"icon") [] [
                    tag (""!"mimetype") [] $ text "image/png",
                    tag (""!"width")    [] $ text "128",
                    tag (""!"height")   [] $ text "128",
                    tag (""!"depth")    [] $ text "32",
                    tag (""!"url")      [] $ text ('/' : pngUri)
                ]
            ],
            tag (""!"serviceList") [] [
                tag (""!"service") [] [
                    tag (""!"serviceType") [] $ text "urn:schemas-upnp-org:service:ContentDirectory:1",
                    tag (""!"serviceId")   [] $ text "urn:upnp-org:serviceId:ContentDirectory",
                    tag (""!"SCPDURL")     [] $ text "/static/UPnP_AV_ContentDirectory_1.0.xml",
                    tag (""!"controlURL")  [] $ text "/upnp/control/content_directory",
                    tag (""!"eventSubURL") [] $ text "/upnp/event/content_directory"
                ],
                tag (""!"service") [] [
                    tag (""!"serviceType") [] $ text "urn:schemas-upnp-org:service:ConnectionManager:1",
                    tag (""!"serviceId")   [] $ text "urn:upnp-org:serviceId:ConnectionManager",
                    tag (""!"SCPDURL")     [] $ text "/static/UPnP_AV_ConnectionManager_1.0.xml",
                    tag (""!"controlURL")  [] $ text "/upnp/control/connection_manager",
                    tag (""!"eventSubURL") [] $ text "/upnp/event/connection_manager"
                ]
            ]
        ]
    ]
    
data BrowseType = BrowseObject
                | BrowseChildren
                deriving (Eq, Ord, Show)

data DIDLItem = Folder { foObjectId :: String, foParentId :: String, foTitle :: String, foChildCount :: Int } 
              | Video  { viResource :: Resource } 
              deriving (Eq, Ord, Show)

browseResponse :: String -> [Resource] -> BrowseType -> String -> Int -> Int -> Int -> B.ByteString
browseResponse url resources browseType objectId start count updateId = asString $ envelope $
    let (object, children) = getObject resources objectId
        items = if browseType == BrowseObject then [object] else children
        total = length items 
    in tag ("u"!"BrowseResponse") ["xmlns"!"u" ~= "urn:schemas-upnp-org:service:ContentDirectory:1"] [
        tag (""!"Result")         [] $ text (showContent $ didl url items start count),
        tag (""!"NumberReturned") [] $ text (show $ min count total),
        tag (""!"TotalMatches")   [] $ text (show total),
        tag (""!"UpdateID")       [] $ text (show updateId)
    ]


defaultDate :: UTCTime
defaultDate = UTCTime (fromGregorian 2001 1 1) (secondsToDiffTime 0)

rootId, latestId, allId :: String
rootId   = "0"
latestId = "latest"
allId    = "all"

rootFolder, latestFolder, allFolder :: [Resource] -> DIDLItem
rootFolder   _         = Folder rootId   "0" "Movies" 2
latestFolder resources = Folder latestId "0" "Latest" (min 10 $ length resources)
allFolder    resources = Folder allId    "0" "All"    (length resources)

getObject :: [Resource] -> String -> (DIDLItem, [DIDLItem])
getObject resources objectId 
    | objectId == rootId   = (rootFolder resources,   [ latestFolder resources, allFolder resources ])
    | objectId == latestId = (latestFolder resources, latestItems resources)
    | objectId == allId    = (allFolder resources,    allItems resources)
    | otherwise            = (rootFolder resources,   [])

latestItems :: [Resource] -> [DIDLItem]
latestItems resources = map Video $ take 10 $ sortBy (flip $ comparing reDate) resources

allItems :: [Resource] -> [DIDLItem]
allItems resources = map Video $ sortBy (comparing reTitle) resources

didl :: String -> [DIDLItem] -> Int -> Int -> Content
didl url items start count = 
    tag (""!"DIDL-Lite") [""!"xmlns" ~= "urn:schemas-upnp-org:metadata-1-0/DIDL-Lite/", "xmlns"!"dc" ~= "http://purl.org/dc/elements/1.1/", "xmlns"!"upnp" ~= "urn:schemas-upnp-org:metadata-1-0/upnp/"] $
        (map (didlItem url) . take count . drop start $ items)

didlItem :: String -> DIDLItem -> Content
didlItem url (Folder fid pid title count) = 
    tag (""!"container") [""!"id" ~= fid, ""!"childCount" ~= show count, ""!"parentID" ~= pid, ""!"restricted" ~= "true"] [
        tag (""!"res")       [""!"protocolInfo" ~= "http-get:*:image/jpeg:DLNA.ORG_PN=JPEG_TN"] $ text (url ++ "/folder/" ++ fid),
        tag ("dc"!"title")   [] $ text title,
        tag ("dc"!"date")    [] $ text (formatDate defaultDate),
        tag ("upnp"!"class") [] $ text "object.container.storageFolder"
    ]
didlItem url (Video resource) = 
    let rid = show $ reID resource in
    tag (""!"item") [""!"id" ~= ("0$" ++ rid), ""!"parentID" ~= "0", ""!"restricted" ~= "true"] [
        tag ("dc"!"title")   [] $ text (reTitle resource),
        tag ("dc"!"date")    [] $ text (formatDate $ reDate resource),
        tag ("upnp"!"class") [] $ text "object.item.videoItem",
        tag ("upnp"!"albumArtURI") ["xmlns"!"dlna" ~= "urn:schemas-dlna-org:metadata-1-0/", "dlna"!"profileID" ~= "JPEG_TN"] $ text (url ++ "/icon/" ++ rid),

        tag (""!"res") [""!"protocolInfo" ~= "http-get:*:image/jpeg:DLNA.ORG_PN=JPEG_TN"
                       ] $ text (url ++ "/icon/" ++ rid),

        tag (""!"res") [ "xmlns"!"dlna"       ~= "urn:schemas-dlna-org:metadata-1-0/"
                       , ""!"protocolInfo"    ~= "http-get:*:video/mpeg:DLNA.ORG_PN=MPEG_PS_NTSC;DLNA.ORG_OP=10"
                       , ""!"duration"        ~= (formatDuration   $ reDuration resource)
                       , ""!"resolution"      ~= (formatResolution $ reResolution resource)
                       , ""!"bitrate"         ~= (show             $ reBitrate resource)
                       , ""!"nrAudioChannels" ~= (show             $ reBitrate resource)
                       , ""!"sampleFrequency" ~= (show             $ reSampleFreq resource)
                       ] $ text (url ++ "/stream/" ++ rid)
    ]


connectionManagerEvent :: B.ByteString
connectionManagerEvent = asString $
    tag ("e"!"propertyset") ["xmlns"!"e" ~= "urn:schemas-upnp-org:event-1-0", "xmlns"!"s" ~= "urn:schemas-upnp-org:service:ConnectionManager:1"] [
        tag ("e"!"property") [] [ tag (""!"SinkProtocolInfo")     [] [] ],
        tag ("e"!"property") [] [ tag (""!"SourceProtocolInfo")   [] [] ],
        tag ("e"!"property") [] [ tag (""!"CurrentConnectionIDs") [] [] ]
    ]

contentDirectoryEvent :: B.ByteString
contentDirectoryEvent = asString $
    tag ("e"!"propertyset") ["xmlns"!"e" ~= "urn:schemas-upnp-org:event-1-0", "xmlns"!"s" ~= "urn:schemas-upnp-org:service:ContentDirectory:1"] [
        tag ("e"!"property") [] [ tag (""!"TransferIDs")        [] []         ],
        tag ("e"!"property") [] [ tag (""!"ContainerUpdateIDs") [] []         ],
        tag ("e"!"property") [] [ tag (""!"SystemUpdateID")     [] (text "1") ]
    ]

formatDate :: UTCTime -> String
formatDate = formatTime defaultTimeLocale "%FT%T"

formatDuration :: Int -> String
formatDuration d = printf "%02d:%02d:%02d.00" (d `div` 3600) ((d `div` 60) `mod` 60) (d `mod` 60)

formatResolution :: (Int, Int) -> String
formatResolution (x, y) = printf "%dx%d" x y