{-# LANGUAGE TupleSections #-}
module Rest.Gen.Docs
  ( DocsContext (..)
  , cdiv
  , cls
  , mkAllResources
  , mkSingleResource
  , resourcesInfo
  , row
  , subResourcesInfo
  , writeDocs
  ) where

import Prelude hiding (div, head, span, (.))
import qualified Prelude as P

import Control.Category ((.))
import Data.Foldable (forM_)
import Data.Function (on)
import Data.Hashable (hash)
import Data.List hiding (head, span)
import Data.String
import System.Directory
import System.FilePath
import Text.Blaze.Html
import Text.Blaze.Html5 hiding (map, meta, style)
import Text.Blaze.Html5.Attributes hiding (id, method, span, title)
import Text.Blaze.Html.Renderer.String
import Text.StringTemplate
import qualified Data.Label.Total            as L
import qualified Text.Blaze.Html5.Attributes as A

import Rest.Api (Router, Version)
import Rest.Gen.Base
import Rest.Gen.Utils

-- | Information about the context in which a resource is contained
data DocsContext = DocsContext
  { rootUrl        :: String
  , contextVersion :: Version
  , templates      :: String
  } deriving (Eq, Show)

writeDocs :: DocsContext -> Router m s -> String -> IO ()
writeDocs context router loc =
  do createDirectoryIfMissing True loc
     let tree = apiSubtrees router
     mkAllResources context tree >>= writeFile (loc </> "index.html")
     mapM_ (writeSingleResource context loc) $ allSubResources tree

writeSingleResource :: DocsContext -> String -> ApiResource -> IO ()
writeSingleResource ctx loc r =
  do let dr = loc </> intercalate "/" (resId r)
     createDirectoryIfMissing True dr
     mkSingleResource ctx r >>= writeFile (dr </> "index.html")

mkAllResources :: DocsContext -> ApiResource -> IO String
mkAllResources ctx tree =
  do tmpls <- directoryGroup (templates ctx)
     tmpl  <- maybe (putStrLn "Couldn't find template api-docs-all" >> return (newSTMP "")) return $
                     getStringTemplate "api-docs-all" tmpls
     return $ render
            $ setManyAttrib
                   [ ("listing"  , map (renderHtml . (\v -> resourceLinkAnchor v (resourceDisp v))) . sort . allSubResourceIds $ tree) ]
            $ setManyAttrib
                   [ ("resources" , renderHtml $ subResourcesInfo ctx tree )
                   , ("version"   , show $ contextVersion ctx  )
                   , ("static"    , rootUrl ctx  )
                   ]
                   tmpl

mkSingleResource :: DocsContext -> ApiResource -> IO String
mkSingleResource ctx tree =
  do tmpls <- directoryGroup (templates ctx)
     tmpl  <- maybe (putStrLn "Couldn't find template api-docs-resource" >> return (newSTMP "")) return $
                     getStringTemplate "api-docs-resource" tmpls
     return $ render
            $ setManyAttrib
                   [ ("subresources", map (renderHtml . (\v -> resourceLinkRemote (rootUrl ctx) v (resourceDisp v))) $ allResourceIds tree)
                   , ("resource"    , resId tree)
                   , ("parents"     , map (renderHtml . (\v -> resourceLinkRemote (rootUrl ctx) v (toHtml $ last v))) $ tail $ inits (resId tree))
                   , ("identifiers" , map renderHtml $ resourceIdentifiers (resLink tree) (resIdents tree))
                   ]
            $ setManyAttrib
                   [ ("name"        , resName tree)
                   , ("urls"        , renderHtml $ resourceTable tree)
                   , ("description" , resDescription tree)
                   , ("version"     , show $ contextVersion ctx)
                   , ("static"      , rootUrl ctx  )
                   ]
                   tmpl

-- | Helper functions for generating HTML
cls :: String -> Attribute
cls = class_ . toValue

cdiv :: String -> Html -> Html
cdiv s = div ! cls s

row :: Html -> Html
row = cdiv "row"

-- | Recursively generate information for a resource structure
resourcesInfo :: DocsContext -> ApiResource -> Html
resourcesInfo ctx = foldTree $ \it -> sequence_ . (resourceInfo ctx it :)

subResourcesInfo :: DocsContext -> ApiResource -> Html
subResourcesInfo ctx = foldTreeChildren sequence_ $ \it -> sequence_ . (resourceInfo ctx it :)

-- | Generate information for one resource
resourceInfo :: DocsContext -> ApiResource -> Html
resourceInfo ctx it = section $
  do resourceAnchor (resId it)
     row $ cdiv "span16 page-header resource-title" $ h1 $ resourceLinkRemote (rootUrl ctx) (resId it) $ resourceDisp (resId it)
     row $
      do cdiv "span10" $
           do h2 $ toHtml "Description"
              p $ toHtml $ resDescription it
         cdiv "span6" $
           do h2 $ toHtml "Identifiers"
              p $ sequence_ $ intersperse br $ resourceIdentifiers (resLink it) (resIdents it)
     br
     resourceTable it

resourceIdentifiers :: Link -> [Link] -> [Html]
resourceIdentifiers lnk lnks =
  case lnks of
    [] -> [toHtml "No identifiers"]
    ls -> map (linkHtml . (lnk ++)) ls

resourceTable :: ApiResource -> Html
resourceTable it =
  let urlInfo = groupByFirst . concatMap (\ai -> map (,itemInfo ai) $ flattenLast $ itemLink ai) $ resItems it
  in table ! cls "bordered-table resource-table" $
      do thead $ mapM_ (\v -> th ! cls v $ toHtml v) ["URL", "Method", "Description", "Input", "Output", "Errors", "Parameters"]
         tbody $ forM_ (zip [(1 :: Int)..] urlInfo) $ \(n, (url, ais)) ->
          do tr ! cls ("stripe-" ++ show (n `mod` 2) ++ " url-main-row") $ mapM_ td
                     [ linkHtml url
                     , toHtml $ show $ method $ P.head ais
                     , toHtml $ mkActionDescription (resName it) $ P.head ais
                     , dataDescriptions "None"  $ inputs $ P.head ais
                     , dataDescriptions "None" $ outputs $ P.head ais
                     , dataDescriptions "None" $ errors $ P.head ais
                     , toHtml $ if null (params (P.head ais)) then "None" else intercalate ", " $ params $ P.head ais
                     ]
             forM_ (tail ais) $ \ai ->
                tr ! cls ("stripe-" ++ show (n `mod` 2) ++ " url-data-row") $ mapM_ td
                     [ return ()
                     , toHtml $ show $ method ai
                     , toHtml $ mkActionDescription (resName it) ai
                     , dataDescriptions "None"  (inputs ai)
                     , dataDescriptions "None" (outputs ai)
                     , dataDescriptions "None" (errors ai)
                     , toHtml $ if null (params ai) then "None" else intercalate ", " $ params ai
                     ]

-- | Generate information for input/output data structure
dataDescriptions :: String -> [DataDescription] -> Html
dataDescriptions s []    = toHtml s
dataDescriptions _ descs =
  table ! cls "data-description" $
    do tr $ forM_ descs $ \dsc -> td $ toHtml . L.get (dataTypeDesc . meta) $ dsc
       tr $ forM_ descs $ \dsc -> td $
        do forM_ (L.get (dataSchema  . meta) dsc) $ mkCode (typeLang (L.get (dataType . desc) dsc)) "Schema"
           forM_ (L.get (dataExample . meta) dsc) $ mkCode (typeLang (L.get (dataType . desc) dsc)) "Example"
  where typeLang XML  = "xml"
        typeLang JSON = "js"
        typeLang _    = ""

-- | Helper function for setting the right attributes to make something collapsible.
-- The javascript prt can be found in docs.js

mkCode :: String -> String -> String -> Html
mkCode lng cap cd =
  let eid = "idv" ++ show (hash cd)
  in do div ! cls "modal hide fade code" ! A.id (toValue eid) $
          do cdiv "modal-header" $
              do a ! href (toValue "#") ! cls "close" $ toHtml "x"
                 h3 $ toHtml cap
             cdiv "modal-body" $
               div ! style (toValue "overflow:auto; max-height:600px") $
                 pre ! cls ("prettyprint lang-" ++ lng) $ toHtml cd
        button ! cls "btn open-modal"
               ! customAttribute (fromString "data-controls-modal") (toValue eid)
               ! customAttribute (fromString "data-backdrop") (toValue "true")
               ! customAttribute (fromString "data-keyboard") (toValue "true")
               $ toHtml cap

resourceId :: ResourceId -> String
resourceId = intercalate "."

resourceDisp :: ResourceId -> Html
resourceDisp = toHtml . intercalate "/"

resourceLinkAnchor :: ResourceId -> Html -> Html
resourceLinkAnchor rid = a ! cls "resource-link" ! href (toValue $ "#" ++ resourceId rid)

resourceLinkRemote :: String -> ResourceId -> Html -> Html
resourceLinkRemote rUrl rid = a ! cls "resource-link" ! href (toValue $ rUrl ++ intercalate "/" rid)

resourceAnchor :: ResourceId -> Html
resourceAnchor rid = a ! name (toValue $ resourceId rid) $ return ()

linkHtml :: Link -> Html
linkHtml =  mapM_ linkItem
  where linkItem (LParam idf)   = toHtml ("/<" ++ idf ++ ">")
        linkItem (LAccess lnks) = span ! class_ (toValue "link-block") $ sequence_ $ intersperse br
                                   $ map linkHtml $ sortBy (flip compare `on` length) lnks
        linkItem x              = toHtml ("/" ++ itemString x)