7 module Rakka.Wiki.Interpreter.Image
11 import Data.Monoid.Unicode
12 import Data.Text (Text)
13 import qualified Data.Text as T
15 import Prelude.Unicode
17 import Rakka.SystemConfig
18 import Rakka.Wiki.Interpreter
21 interpreters ∷ [Interpreter]
22 interpreters = [ imageInterp
26 -- <img src="[PageName]"
27 -- alt="[Alternative]" -- 省略可能
28 -- link="[PageName]" -- 省略可能、省略時は画像そのものへのリンク
29 -- link="[Absolute URI]" -- 絶對 URI の場合はその URI へのリンク
30 -- link="" /> -- 空文字列の場合はリンク無し
32 -- <a href="..." class="inlineImage ...">
33 -- <img src="..." alt="..." />
35 imageInterp ∷ Interpreter
37 = InlineCommandInterpreter {
40 = \(InterpreterContext {..}) (InlineCommand _ attrs _) →
41 do BaseURI baseURI ← getSysConf ctxSysConf
42 let name = case lookup "src" attrs of
44 Nothing → error "\"src\" attribute is missing"
45 link = case lookup "link" attrs of
49 | otherwise → Just ∘ T.pack $ uriToString id (mkPageURI baseURI x ) ""
50 Nothing → Just ∘ T.pack $ uriToString id (mkPageURI baseURI name) ""
51 alt = lookup "alt" attrs
52 classAttr = case lookup "float" attrs of
53 Nothing → "inlineImage"
54 Just "left" → "inlineImage leftFloat"
55 Just "right" → "inlineImage rightFloat"
56 Just others → error ("unknown \"float\" attribute: " ⊕ T.unpack others)
58 Nothing → Span [("class", classAttr)] [Image (Right name) alt]
59 Just x → Anchor [ ("class", classAttr)
60 , ("href" , x ) ] [Image (Right name) alt]
65 -- <div class="imageFrame ...">
66 -- <div class="imageData">
71 -- <div class="imageCaption">
75 imgFrameInterp ∷ Interpreter
77 = BlockCommandInterpreter {
80 = \(InterpreterContext {..}) (BlockCommand _ attrs inside) →
81 do BaseURI baseURI ← getSysConf ctxSysConf
82 let name = case lookup "src" attrs of
84 Nothing → error "\"src\" attribute is missing"
85 link = case lookup "link" attrs of
89 | otherwise → Just ∘ T.pack $ uriToString id (mkPageURI baseURI x ) ""
90 Nothing → Just ∘ T.pack $ uriToString id (mkPageURI baseURI name) ""
91 classAttr = case lookup "float" attrs of
92 Nothing → ("class", "imageFrame")
93 Just "left" → ("class", "imageFrame leftFloat")
94 Just "right" → ("class", "imageFrame rightFloat")
95 Just others → error ("unknown \"float\" attribute: " ⊕ T.unpack others)
97 Nothing → Image (Right name) Nothing
98 Just x → Anchor [("href" , x)] [Image (Right name) Nothing]
100 return (Div [classAttr]
101 [ Block (Div [("class", "imageData")]
103 , Block (Div [("class", "imageCaption")]
104 [ Block x | x ← inside ])
110 isURI' = isURI ∘ T.unpack