{-# LANGUAGE
    OverloadedStrings
  , RecordWildCards
  , UnicodeSyntax
  #-}
module Rakka.Wiki.Interpreter.Base
    ( interpreters
    )
    where
import Control.Applicative
import Control.Arrow
import Control.Arrow.ListArrow
import Control.Arrow.Unicode
import qualified Data.CaseInsensitive as CI
import Data.Map (Map)
import qualified Data.Map as M
import Data.Maybe
import Data.Monoid.Unicode
import qualified Data.Text as T
import Prelude.Unicode
import Rakka.Page
import Rakka.SystemConfig
import Rakka.Wiki
import Rakka.Wiki.Interpreter
import Text.XML.HXT.Arrow.XmlArrow
import Text.XML.HXT.XPath

interpreters ∷ [Interpreter]
interpreters = [ lineBreakInterp
               , spanInterp
               , divInterp
               , pageNameInterp
               , otherLangsInterp
               , newPageInterp
               , editPageInterp
               , loginInterp
               , searchFieldInterp
               , configurationInterp
               ]

lineBreakInterp :: Interpreter
lineBreakInterp = InlineCommandInterpreter {
                    iciName = "br"
                  , iciInterpret
                      = \ _ (InlineCommand _ attrs _) -> return $ LineBreak attrs
                  }


spanInterp :: Interpreter
spanInterp = InlineCommandInterpreter {
               iciName = "span"
             , iciInterpret
                 = \ _ (InlineCommand _ attrs contents) -> return $ Span attrs contents
             }


divInterp :: Interpreter
divInterp = BlockCommandInterpreter {
              bciName = "div"
            , bciInterpret
                = \ _ (BlockCommand _ attrs contents)
                -> return $ Div attrs (map Block contents)
            }


pageNameInterp :: Interpreter
pageNameInterp = InlineCommandInterpreter {
                   iciName = "pageName"
                 , iciInterpret
                     = \ ctx _ -> return $ Text (fromMaybe "" $ ctxPageName ctx)
                 }

otherLangsInterp ∷ Interpreter
otherLangsInterp
    = BlockCommandInterpreter {
        bciName = "inOtherLanguages"
      , bciInterpret
          = \(InterpreterContext {..}) _ →
            let linkTable = case ctxMainPage of
                              Just page → runLA ( getXPathTreesInDoc "/page/otherLang/link"
                                                  ⋙
                                                  ( getAttrValue0 "lang"
                                                    &&&
                                                    getAttrValue0 "page"
                                                  )
                                                ) page
                              Nothing   → []
            in
              case linkTable of
                [] -> return EmptyBlock
                _  -> do Languages langTable ← getSysConf ctxSysConf
                         let merged = mergeTables langTable $
                                      (CI.mk ∘ T.pack ⁂ T.pack) <$> linkTable
                         pure $ mkLangList merged
      }
    where
      mergeTables ∷ Map LanguageTag LanguageName
                  → [(LanguageTag, PageName)]
                  → [(LanguageName, PageName)]
      mergeTables _ []     = []
      mergeTables m (x:xs) = let (langTag, name) = x
                                 langName        = fromMaybe (CI.foldedCase langTag)
                                                             (M.lookup langTag m)
                             in
                               (langName, name) : mergeTables m xs

      mkLangList ∷ [(LanguageName, PageName)] → BlockElement
      mkLangList = List Bullet ∘ (mkLangLink <$>)

      mkLangLink ∷ (LanguageName, PageName) → ListItem
      mkLangLink (langName, name)
          = [Inline (PageLink (Just name) Nothing (Just langName))]


-- <input type="button"
--        value="Create new page"
--        onclick="Rakka.newPage()"
--        class="newButton controls" />
newPageInterp :: Interpreter
newPageInterp 
    = InlineCommandInterpreter {
        iciName = "newPage"
      , iciInterpret
          = \ _ (InlineCommand _ args _) ->
            let label = fromMaybe "Create new page" (lookup "label" args)
                attrs = [ ("type"   , "button")
                        , ("value"  , label)
                        , ("onclick", "Rakka.newPage()")
                        , ("class"  , "newButton controls")
                        ]
            in
              return (Input attrs)
      }


-- <input type="button"
--        value="Edit"
--        onclick="Rakka.editPage(\"Foo\")"
--        class="editButton controls" />
editPageInterp ∷ Interpreter
editPageInterp 
    = InlineCommandInterpreter {
        iciName = "editPage"
      , iciInterpret
          = \ctx (InlineCommand _ args _) →
            let name  = fromMaybe (fromMaybe "" $ ctxPageName ctx) (lookup "page" args)
                label = fromMaybe "Edit this page" (lookup "label" args)
                attrs = [ ("type"   , "button")
                        , ("value"  , label)
                        , ("onclick", "Rakka.editPage(\"" ⊕ name ⊕ "\")")
                        , ("class"  , "editButton controls")
                        ]
            in
              return (Input attrs)
      }


-- <input type="button"
--        value="Login"
--        class="loginButton controls" />
loginInterp :: Interpreter
loginInterp 
    = InlineCommandInterpreter {
        iciName = "login"
      , iciInterpret
          = \ _ _ ->
            let attrs = [ ("type" , "button")
                        , ("value", "Login")
                        , ("class", "loginButton controls")
                        ]
            in
              return (Input attrs)
      }


-- <input type="text"
--        class="searchField" />
searchFieldInterp :: Interpreter
searchFieldInterp 
    = InlineCommandInterpreter {
        iciName = "searchField"
      , iciInterpret
          = \ _ _ ->
            let attrs = [ ("type" , "text")
                        , ("class", "searchField")
                        ]
            in
              return (Input attrs)
      }

-- <input type="button"
--        value="Configuration"
--        class="configButton controls" />
configurationInterp ∷ Interpreter
configurationInterp 
    = InlineCommandInterpreter {
        iciName = "configuration"
      , iciInterpret
          = \_ _ →
            let attrs = [ ("type" , "button")
                        , ("value", "Configuration")
                        , ("class", "configButton controls")
                        ]
            in
              return (Input attrs)
      }