[server] fixing wikilinks

3 files changed, 23 insertions, 6 deletions

diff --git a/app/Main.hs b/app/Main.hs
index 005b63a..0368b77 100644
--- a/app/Main.hs
+++ b/app/Main.hs
@@ -67,7 +67,9 @@ import           Options.Applicative            ( Parser
                                                 )
 import           Prelude                 hiding ( takeWhile )
 import           Servall.Types
-import           Servall.WikiParser             ( parseWikiTemplates )
+import           Servall.WikiParser             ( parseWikiTemplates
+                                                , wikiFilter
+                                                )
 import           Servant                        ( (:<|>)(..)
                                                 , (:>)
                                                 , Application
@@ -152,9 +154,10 @@ getWikiFormat name = do
 getOrgFormat :: Text -> Handler Text
 getOrgFormat name = do
   wiki <- getWikiFormat name
-  liftIO $ runIOorExplode $ readMediaWiki def wiki >>= writeOrg def
-    { writerWrapText = WrapNone
-    }
+  liftIO
+    $   runIOorExplode
+    $   (wikiFilter <$> readMediaWiki def wiki)
+    >>= writeOrg def { writerWrapText = WrapNone }
 
 getPandocFormat :: Text -> Handler Text
 getPandocFormat name = do
diff --git a/servall.cabal b/servall.cabal
index 3792993..2fb2eca 100644
--- a/servall.cabal
+++ b/servall.cabal
@@ -26,7 +26,8 @@ library
   default-language: Haskell2010
   exposed-modules: Servall.Types, Servall.WikiParser
   hs-source-dirs: src
-  build-depends: aeson, base, attoparsec, text, unordered-containers
+  build-depends: aeson, base, attoparsec, text, pandoc-types
+               , unordered-containers
    
 executable servall
     main-is:          Main.hs
@@ -37,7 +38,7 @@ executable servall
     -- other-extensions:
     build-depends:    aeson, attoparsec, base, bytestring
                     , lens, lens-aeson, optparse-applicative
-                    , pandoc, process, regex-tdfa
+                    , pandoc, pandoc-types, process, regex-tdfa
                     , servant, servant-server
                     , text, unordered-containers, warp, wreq
     hs-source-dirs:   app, src
diff --git a/src/Servall/WikiParser.hs b/src/Servall/WikiParser.hs
index ec15e1c..2680fad 100644
--- a/src/Servall/WikiParser.hs
+++ b/src/Servall/WikiParser.hs
@@ -1,6 +1,7 @@
 {-# LANGUAGE OverloadedStrings #-}
 module Servall.WikiParser
   ( parseWikiTemplates
+  , wikiFilter
   ) where
 
 import           Control.Applicative            ( (<|>) )
@@ -31,6 +32,10 @@ import qualified Data.Text                     as T
 import           Data.Text                      ( Text )
 import           GHC.Generics                   ( Generic )
 import           Servall.Types
+import           Text.Pandoc.Definition         ( Inline(..)
+                                                , Pandoc
+                                                )
+import           Text.Pandoc.Generic            ( topDown )
 
 parseWikiTemplates :: Text -> Either String [WikiTemplate]
 parseWikiTemplates = parseOnly wikiP
@@ -103,3 +108,11 @@ wikilinkP = do
   beg     <- string "[["
   content <- T.pack <$> manyTill anyChar (string "]]")
   return $ beg <> content <> "]]"
+
+wikiFilter :: Pandoc -> Pandoc
+wikiFilter = topDown fixUrl
+
+fixUrl :: Inline -> Inline
+fixUrl (Link attr label (url, "wikilink")) =
+  Link attr label ("wiki:" <> url, "")
+fixUrl x = x