{-# LANGUAGE
    OverloadedStrings
  , RecordWildCards
  , UnicodeSyntax
  , ViewPatterns
  #-}
module Rakka.Wiki.Interpreter.Image
    ( interpreters
    )
    where
import Data.Monoid.Unicode
import Data.Text (Text)
import qualified Data.Text as T
import Network.URI
import Prelude.Unicode
import Rakka.Page
import Rakka.SystemConfig
import Rakka.Wiki.Interpreter
import Rakka.Wiki

interpreters ∷ [Interpreter]
interpreters = [ imageInterp
               , imgFrameInterp
               ]

-- <img src="[PageName]"
--      alt="[Alternative]"   -- 省略可能
--      link="[PageName]"     -- 省略可能、省略時は画像そのものへのリンク
--      link="[Absolute URI]" -- 絶對 URI の場合はその URI へのリンク
--      link="" />            -- 空文字列の場合はリンク無し

-- <a href="..." class="inlineImage ...">
--   <img src="..." alt="..." />
-- </a>
imageInterp ∷ Interpreter
imageInterp
    = InlineCommandInterpreter {
        iciName = "img"
      , iciInterpret
          = \(InterpreterContext {..}) (InlineCommand _ attrs _) →
            do BaseURI baseURI ← getSysConf ctxSysConf
               let name        = case lookup "src" attrs of
                                   Just x  → x
                                   Nothing → error "\"src\" attribute is missing"
                   link        = case lookup "link" attrs of
                                   Just x
                                       | T.null x  → Nothing
                                       | isURI' x  → Just x
                                       | otherwise → Just ∘ T.pack $ uriToString id (mkPageURI baseURI x   ) ""
                                   Nothing         → Just ∘ T.pack $ uriToString id (mkPageURI baseURI name) ""
                   alt         = lookup "alt" attrs
                   classAttr   = case lookup "float" attrs of
                                   Nothing      → "inlineImage"
                                   Just "left"  → "inlineImage leftFloat"
                                   Just "right" → "inlineImage rightFloat"
                                   Just others  → error ("unknown \"float\" attribute: " ⊕ T.unpack others)
                   result      = case link of
                                   Nothing → Span [("class", classAttr)] [Image (Right name) alt]
                                   Just x  → Anchor [ ("class", classAttr)
                                                    , ("href" , x        ) ] [Image (Right name) alt]
               return result
      }


-- <div class="imageFrame ...">
--   <div class="imageData">
--     <a href="...">
--       <img src="..." />
--     </a>
--   </div>
--   <div class="imageCaption">
--     ...
--   </div>
-- </div>
imgFrameInterp ∷ Interpreter
imgFrameInterp
    = BlockCommandInterpreter {
        bciName = "imgframe"
      , bciInterpret
          = \(InterpreterContext {..}) (BlockCommand _ attrs inside) →
            do BaseURI baseURI ← getSysConf ctxSysConf
               let name        = case lookup "src" attrs of
                                   Just x  → x
                                   Nothing → error "\"src\" attribute is missing"
                   link        = case lookup "link" attrs of
                                   Just x
                                       | T.null x  → Nothing
                                       | isURI' x  → Just x
                                       | otherwise → Just ∘ T.pack $ uriToString id (mkPageURI baseURI x   ) ""
                                   Nothing         → Just ∘ T.pack $ uriToString id (mkPageURI baseURI name) ""
                   classAttr   = case lookup "float" attrs of
                                   Nothing      → ("class", "imageFrame")
                                   Just "left"  → ("class", "imageFrame leftFloat")
                                   Just "right" → ("class", "imageFrame rightFloat")
                                   Just others  → error ("unknown \"float\" attribute: " ⊕ T.unpack others)
                   image       = case link of
                                   Nothing → Image (Right name) Nothing
                                   Just x  → Anchor [("href" , x)] [Image (Right name) Nothing]
               
               return (Div [classAttr]
                       [ Block (Div [("class", "imageData")]
                                        [ Inline image ])
                       , Block (Div [("class", "imageCaption")]
                                        [ Block x | x ← inside ])
                       ]
                      )
      }

isURI' ∷ Text → Bool
isURI' = isURI ∘ T.unpack