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 _) ->
  30             do BaseURI baseURI <- getSysConf (ctxSysConf ctx)
  31
  32                let name        = case lookup "src" attrs of
  33                                    Just x  -> x
  34                                    Nothing -> error "\"src\" attribute is missing"
  35                    hrefAttr    = ("href", uriToString id (mkPageURI baseURI name) "")
  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 (Right name) alt])
  45       }
  46
  47
  48 -- <div class="imageFrame ...">
  49 --   <div class="imageData">
  50 --     <a href="...">
  51 --       <img src="..." />
  52 --     </a>
  53 --   </div>
  54 --   <div class="imageCaption">
  55 --     ...
  56 --   </div>
  57 -- </div>
  58 imgFrameInterp :: Interpreter
  59 imgFrameInterp
  60     = BlockCommandInterpreter {
  61         bciName      = "imgframe"
  62       , bciInterpret
  63           = \ ctx (BlockCommand _ attrs inside) ->
  64             do BaseURI baseURI <- getSysConf (ctxSysConf ctx)
  65
  66                let name        = case lookup "src" attrs of
  67                                    Just x  -> x
  68                                    Nothing -> error "\"src\" attribute is missing"
  69                    hrefAttr    = ("href", uriToString id (mkPageURI baseURI name) "")
  70                    classAttr   = case lookup "float" attrs of
  71                                    Nothing      -> ("class", "imageFrame")
  72                                    Just "left"  -> ("class", "imageFrame leftFloat")
  73                                    Just "right" -> ("class", "imageFrame rightFloat")
  74                                    Just others  -> error ("unknown \"float\" attribute: " ++ others)
  75
  76                return (Div [classAttr]
  77                        [ Block (Div [("class", "imageData")]
  78                                         [ Inline (Anchor [hrefAttr]
  79                                                   [ Image (Right name) Nothing ]) ])
  80                        , Block (Div [("class", "imageCaption")]
  81                                         [ Block x | x <- inside ])
  82                        ]
  83                       )
  84       }