Rakka/Wiki/Interpreter/Image.hs

   1 module Rakka.Wiki.Interpreter.Image
   2     ( interpreters
   3     )
   4     where
   5
   6 import           Control.Monad
   7 import           Data.Maybe
   8 import           Network.URI
   9 import           Rakka.Page
  10 import           Rakka.SystemConfig
  11 import           Rakka.Wiki.Interpreter
  12 import           Rakka.Wiki
  13
  14
  15 interpreters :: [Interpreter]
  16 interpreters = [ imageInterp
  17                , imgFrameInterp
  18                ]
  19
  20
  21 -- <a href="..." class="inlineImage ...">
  22 --   <img src="..." alt="..." />
  23 -- </a>
  24 imageInterp :: Interpreter
  25 imageInterp
  26     = InlineCommandInterpreter {
  27         iciName      = "img"
  28       , iciInterpret
  29           = \ ctx (InlineCommand _ attrs inside) ->
  30             do BaseURI baseURI <- getSysConf (ctxSysConf ctx)
  31
  32                let pageName    = case lookup "src" attrs of
  33                                    Just x  -> x
  34                                    Nothing -> error "\"src\" attribute is missing"
  35                    hrefAttr    = ("href", uriToString id (mkPageURI baseURI pageName) "")
  36                    alt         = lookup "alt" attrs
  37                    classAttr   = case lookup "float" attrs of
  38                                    Nothing      -> ("class", "inlineImage")
  39                                    Just "left"  -> ("class", "inlineImage leftFloat")
  40                                    Just "right" -> ("class", "inlineImage rightFloat")
  41                                    Just others  -> error ("unknown \"float\" attribute: " ++ others)
  42                    anchorAttrs = [hrefAttr, classAttr]
  43
  44                return (Anchor anchorAttrs [Image pageName alt])
  45       }
  46
  47
  48 -- <div class="imageFrame ...">
  49 --   <div class="imageData">
  50 --     <p>
  51 --       <a href="...">
  52 --         <img src="..." />
  53 --       </a>
  54 --     </p>
  55 --   </div>
  56 --   <div class="imageCaption">
  57 --     ...
  58 --   </div>
  59 -- </div>
  60 imgFrameInterp :: Interpreter
  61 imgFrameInterp
  62     = BlockCommandInterpreter {
  63         bciName      = "imgframe"
  64       , bciInterpret
  65           = \ ctx (BlockCommand _ attrs inside) ->
  66             do BaseURI baseURI <- getSysConf (ctxSysConf ctx)
  67
  68                let pageName    = case lookup "src" attrs of
  69                                    Just x  -> x
  70                                    Nothing -> error "\"src\" attribute is missing"
  71                    hrefAttr    = ("href", uriToString id (mkPageURI baseURI pageName) "")
  72                    classAttr   = case lookup "float" attrs of
  73                                    Nothing      -> ("class", "imageFrame")
  74                                    Just "left"  -> ("class", "imageFrame leftFloat")
  75                                    Just "right" -> ("class", "imageFrame rightFloat")
  76                                    Just others  -> error ("unknown \"float\" attribute: " ++ others)
  77
  78                return (Div [classAttr]
  79                        [ Div [("class", "imageData")]
  80                          [ Paragraph [ Anchor [hrefAttr]
  81                                                   [ Image pageName Nothing ] ]
  82                          ]
  83                        , Div [("class", "imageCaption")] inside
  84                        ]
  85                       )
  86       }