{-# LANGUAGE
    MultiParamTypeClasses
  , OverloadedStrings
  #-}

module Application.Links where

import Data.Maybe (isJust)
import Data.Monoid
import qualified Data.Text as T
import Control.Monad.Catch

import Path.Extended
import Lucid



-- * Stringless Routes

-- | Use these constructors to make links in your web page:
--
--   > foo :: MonadUrl Abs File m => HtmlT m ()
--   > foo = do
--   >   link <- lift (locUrl =<< toLocation AppHome)
--   >   a_ [href_ link] "Home page"
data AppLinks
  = AppHome (Maybe AppHomeLinks)
  | AppDocs (Maybe AppDocsLinks)
  | AppGlossary
  | AppGlossaryNew String
  | AppLoginCallback
  | AppLoginVerify
  | AppLogout
  | JsElm
  | JsJQuery
  | JsJQueryVisible
  | JsSemantic
  | CssSemantic
  | ImgLogo
  | ImgLogoLight
  | Img404Cat
  | ImgHaskellLogo
  deriving (Show, Eq)

data AppHomeLinks
  = AppMainPanel
  | AppCodeSample
  deriving (Show, Eq)

data AppDocsLinks
  = AppHaskellEdu
  | AppGettingStarted
  | AppURLMatching
  | AppPredicates
  | AppRouteCombinators
  | AppHTTPVerbs
  | AppUploadingData
  | AppResponding
  | AppSensitiveLocations
  | AppSessions
  | AppMonadTrans
  | AppCatchingExceptions
  deriving (Show, Eq, Ord, Enum, Bounded)



instance ToPath AppLinks Abs File where
  toPath (AppHome mx)       = do h <- parseAbsFile "/home"
                                 case mx of
                                   Nothing -> return h
                                   Just x  -> do x' <- toPath x
                                                 return (toDir h </> x')
  toPath (AppDocs mx)       = do h <- parseAbsFile "/docs"
                                 case mx of
                                   Nothing -> return h
                                   Just x  -> do x' <- toPath x
                                                 return (toDir h </> x')
  toPath AppGlossary        = parseAbsFile "/glossary"
  toPath (AppGlossaryNew s) = parseAbsFile $ "/glossary/" ++ s
  toPath AppLoginCallback   = parseAbsFile "/login-callback"
  toPath AppLoginVerify     = parseAbsFile "/login-verify"
  toPath AppLogout          = parseAbsFile "/logout"
  toPath JsElm              = parseAbsFile "/elm"
--  toPath JsJQuery           = parseAbsFile "/vendor/jquery/dist/jquery"
  toPath JsJQuery           = parseAbsFile "/ajax/libs/jquery/3.0.0-alpha1/jquery"
  toPath JsJQueryVisible    = parseAbsFile "/vendor/df-visible/jquery.visible.min.js"
--  toPath JsSemantic         = parseAbsFile "/vendor/semantic-ui/dist/semantic"
  toPath JsSemantic         = parseAbsFile "/ajax/libs/semantic-ui/2.1.6/semantic"
--  toPath CssSemantic        = parseAbsFile "/vendor/semantic-ui/dist/semantic"
  toPath CssSemantic        = parseAbsFile "/ajax/libs/semantic-ui/2.1.6/semantic"
  toPath ImgLogo            = parseAbsFile "/images/logo"
  toPath ImgLogoLight       = parseAbsFile "/images/logo-no-border"
  toPath Img404Cat          = parseAbsFile "/images/404"
  toPath ImgHaskellLogo     = parseAbsFile "/images/haskell-logo"

instance ToLocation AppLinks Abs File where
  toLocation x =
    let fe = case x of
               JsElm       -> addFileExt "js"
               JsJQuery    -> addFileExt "min.js"
               JsSemantic  -> addFileExt "min.js"
               CssSemantic -> addFileExt "min.css"
               Img404Cat   -> addFileExt "webm"
               _           -> id
    in (fe . fromPath) <$> toPath x

instance ToPath AppHomeLinks Rel File where
  toPath AppMainPanel  = parseRelFile "main-panel"
  toPath AppCodeSample = parseRelFile "code-sample"

instance ToLocation AppHomeLinks Rel File where
  toLocation x = fromPath <$> toPath x

instance ToPath AppDocsLinks Rel File where
  toPath AppGettingStarted     = parseRelFile "getting-started"
  toPath AppHaskellEdu         = parseRelFile "haskell-edu"
  toPath AppURLMatching        = parseRelFile "url-matching"
  toPath AppPredicates         = parseRelFile "predicates"
  toPath AppRouteCombinators   = parseRelFile "route-combinators"
  toPath AppHTTPVerbs          = parseRelFile "http-verbs"
  toPath AppUploadingData      = parseRelFile "uploading-data"
  toPath AppResponding         = parseRelFile "responding"
  toPath AppSensitiveLocations = parseRelFile "sensitive-locations"
  toPath AppSessions           = parseRelFile "sessions"
  toPath AppMonadTrans         = parseRelFile "monad-trans"
  toPath AppCatchingExceptions = parseRelFile "catching-exceptions"

instance ToLocation AppDocsLinks Rel File where
  toLocation x = fromPath <$> toPath x


class ToBreadcrumb x where
  toBreadcrumb :: Monad m => x -> HtmlT m ()

instance ( ToBreadcrumb a
         ) => ToBreadcrumb (Maybe a) where
  toBreadcrumb Nothing  = return ()
  toBreadcrumb (Just x) = toBreadcrumb x

instance ToBreadcrumb AppLinks where
  toBreadcrumb (AppDocs mx) = do
    a_ [class_ "section"] "Docs"
    case mx of
      Nothing -> return ()
      Just x  -> do i_ [class_ "right chevron icon divider"] ""
                    toBreadcrumb x
  toBreadcrumb _ = return ()

instance ToBreadcrumb AppDocsLinks where
  toBreadcrumb AppGettingStarted = do
    a_ [class_ "section"] "Getting Started"


class ToPageTitle x where
  toPageTitle :: x -> T.Text

instance ( ToPageTitle a
         ) => ToPageTitle (Maybe a) where
  toPageTitle (Just x) = toPageTitle x
  toPageTitle Nothing  = ""

instance ToPageTitle AppLinks where
  toPageTitle l =
    case l of
      (AppHome _)  -> "Homepage"
      (AppDocs mx) -> "Docs" <> (if isJust mx then " » " else "") <> toPageTitle mx
      AppGlossary  -> "Glossary"
      _ -> ""

instance ToPageTitle AppDocsLinks where
  toPageTitle AppGettingStarted     = "Getting Started"
  toPageTitle AppHaskellEdu         = "Haskell Prerequisites"
  toPageTitle AppURLMatching        = "URL Matching Expressions"
  toPageTitle AppPredicates         = "Predicates"
  toPageTitle AppRouteCombinators   = "Route Combinators"
  toPageTitle AppHTTPVerbs          = "HTTP Verbs"
  toPageTitle AppUploadingData      = "Uploading Data"
  toPageTitle AppResponding         = "Responding with Content"
  toPageTitle AppSensitiveLocations = "Representing Sensitive Locations"
  toPageTitle AppSessions           = "Sessions and Security"
  toPageTitle AppMonadTrans         = "Monad Transformer Stacks"
  toPageTitle AppCatchingExceptions = "Catching Exceptions"


class ToMenuName x where
  toMenuName :: x -> T.Text

instance ToMenuName AppLinks where
  toMenuName (AppHome Nothing)  = "Home"
  toMenuName (AppHome _)        = ""
  toMenuName (AppDocs Nothing)  = "Docs"
  toMenuName (AppDocs (Just i)) = toMenuName i
  toMenuName AppGlossary        = "Glossary"
  toMenuName _ = ""

instance ToMenuName AppDocsLinks where
  toMenuName AppGettingStarted     = "Getting Started"
  toMenuName AppHaskellEdu         = "Haskell Prerequisites"
  toMenuName AppURLMatching        = "URL Matching Expressions"
  toMenuName AppPredicates         = "Predicates"
  toMenuName AppRouteCombinators   = "Route Combinators"
  toMenuName AppHTTPVerbs          = "HTTP Verbs"
  toMenuName AppUploadingData      = "Uploading Data"
  toMenuName AppResponding         = "Responding with Content"
  toMenuName AppSensitiveLocations = "Representing Sensitive Locations"
  toMenuName AppSessions           = "Sessions and Security"
  toMenuName AppMonadTrans         = "Monad Transformer Stacks"
  toMenuName AppCatchingExceptions = "Catching Exceptions"


class ToMarkdownSource x where
  toMarkdownSource :: MonadThrow m => x -> m (Path Rel File)

instance ToMarkdownSource AppLinks where
  toMarkdownSource (AppHome mx) =
    case mx of
      Just x -> toMarkdownSource x
      _      -> error "Requesting for a markdown file that doesn't exist"
  toMarkdownSource (AppDocs mx) =
    case mx of
      Just x  -> toMarkdownSource x
      Nothing -> parseRelFile "docs/intro.md"
  toMarkdownSource _ = error "Requesting for a markdown file that doesn't exist"

instance ToMarkdownSource AppHomeLinks where
  toMarkdownSource x
    | x == AppMainPanel  = parseRelFile "home/mainPanel.md"
    | x == AppCodeSample = parseRelFile "home/codeSample.md"
    | otherwise = error "Requesting for a markdown file that doesn't exist"

instance ToMarkdownSource AppDocsLinks where
  toMarkdownSource x
    | x == AppGettingStarted     = parseRelFile "docs/gettingStarted.md"
    | x == AppHaskellEdu         = parseRelFile "docs/haskellEdu.md"
    | x == AppURLMatching        = parseRelFile "docs/urlMatching.md"
    | x == AppPredicates         = parseRelFile "docs/predicates.md"
    | x == AppRouteCombinators   = parseRelFile "docs/routeCombinators.md"
    | x == AppHTTPVerbs          = parseRelFile "docs/httpVerbs.md"
    | x == AppUploadingData      = parseRelFile "docs/uploadingData.md"
    | x == AppResponding         = parseRelFile "docs/responding.md"
    | x == AppSensitiveLocations = parseRelFile "docs/sensitiveLocs.md"
    | x == AppSessions           = parseRelFile "docs/sessions.md"
    | x == AppMonadTrans         = parseRelFile "docs/monadTrans.md"
    | x == AppCatchingExceptions = parseRelFile "docs/catchingExceptions.md"
    | otherwise = error "Requesting for a markdown file that doesn't exist"


class ToMenuIcon x where
  toMenuIcon :: Monad m => x -> HtmlT m ()

instance ToMenuIcon AppLinks where
  toMenuIcon (AppHome Nothing) = i_ [class_ "home icon"] ""
  toMenuIcon (AppDocs Nothing) = i_ [class_ "book icon"] ""
  toMenuIcon AppGlossary       = i_ [class_ "unordered list icon"] ""
  toMenuIcon _ = return ()
