X-Git-Url: http://git.cielonegro.org/gitweb.cgi?a=blobdiff_plain;f=Rakka%2FWiki%2FInterpreter%2FImage.hs;h=886fdf512732228f1f746b7481d81bf0987b4c07;hb=42f51754dea02201aececaacbf194d714cd58aaf;hp=97ffc8e1fafebc738a0818af3820548f417ac882;hpb=65c7f9f0643c7e8884e4a02567b77c169167c093;p=Rakka.git
diff --git a/Rakka/Wiki/Interpreter/Image.hs b/Rakka/Wiki/Interpreter/Image.hs
index 97ffc8e..886fdf5 100644
--- a/Rakka/Wiki/Interpreter/Image.hs
+++ b/Rakka/Wiki/Interpreter/Image.hs
@@ -1,47 +1,64 @@
+{-# 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
-import Control.Monad
-import Data.Maybe
-import Network.URI
-import Rakka.Page
-import Rakka.SystemConfig
-import Rakka.Wiki.Interpreter
-import Rakka.Wiki
-
-
-interpreters :: [Interpreter]
+interpreters â· [Interpreter]
interpreters = [ imageInterp
, imgFrameInterp
]
+-- -- 空æååã®å ´åã¯ãªã³ã¯ç¡ã
--
--
--
-imageInterp :: Interpreter
+imageInterp â· Interpreter
imageInterp
= InlineCommandInterpreter {
- iciName = "img"
+ iciName = "img"
, iciInterpret
- = \ ctx (InlineCommand _ attrs inside) ->
- do BaseURI baseURI <- getSysConf (ctxSysConf ctx)
-
- let pageName = case lookup "src" attrs of
- Just x -> x
- Nothing -> error "\"src\" attribute is missing"
- hrefAttr = ("href", uriToString id (mkPageURI baseURI pageName) "")
+ = \(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 -> ("class", "inlineImage")
- Just "left" -> ("class", "inlineImage leftFloat")
- Just "right" -> ("class", "inlineImage rightFloat")
- Just others -> error ("unknown \"float\" attribute: " ++ others)
- anchorAttrs = [hrefAttr, classAttr]
-
- return (Anchor anchorAttrs [Image (Right pageName) alt])
+ 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
}
@@ -55,30 +72,39 @@ imageInterp
-- ...
--
--
-imgFrameInterp :: Interpreter
+imgFrameInterp â· Interpreter
imgFrameInterp
= BlockCommandInterpreter {
- bciName = "imgframe"
+ bciName = "imgframe"
, bciInterpret
- = \ ctx (BlockCommand _ attrs inside) ->
- do BaseURI baseURI <- getSysConf (ctxSysConf ctx)
-
- let pageName = case lookup "src" attrs of
- Just x -> x
- Nothing -> error "\"src\" attribute is missing"
- hrefAttr = ("href", uriToString id (mkPageURI baseURI pageName) "")
+ = \(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: " ++ others)
+ 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 (Anchor [hrefAttr]
- [ Image (Right pageName) Nothing ]) ])
+ [ Inline image ])
, Block (Div [("class", "imageCaption")]
- [ Block x | x <- inside ])
+ [ Block x | x â inside ])
]
)
}
+
+isURI' â· Text â Bool
+isURI' = isURI â T.unpack
\ No newline at end of file