separating out wikiparser and types and added config

2 files changed, 118 insertions, 0 deletions

diff --git a/src/Servall/Types.hs b/src/Servall/Types.hs
new file mode 100644
index 0000000..e179e2c
--- /dev/null
+++ b/src/Servall/Types.hs
@@ -0,0 +1,13 @@
+module Servall.Types
+  ( WikiTemplate(..)
+  ) where
+
+import qualified Data.HashMap.Lazy             as HM
+import           Data.Text                      ( Text )
+
+data WikiTemplate = WikiTemplate
+  { wtName   :: Text
+  -- , wtSubName :: Maybe Text
+  , wtFields :: HM.HashMap Text Text
+  }
+  deriving Show
diff --git a/src/Servall/WikiParser.hs b/src/Servall/WikiParser.hs
new file mode 100644
index 0000000..ec15e1c
--- /dev/null
+++ b/src/Servall/WikiParser.hs
@@ -0,0 +1,105 @@
+{-# LANGUAGE OverloadedStrings #-}
+module Servall.WikiParser
+  ( parseWikiTemplates
+  ) where
+
+import           Control.Applicative            ( (<|>) )
+import           Data.Attoparsec.Combinator     ( lookAhead )
+import           Data.Attoparsec.Text           ( Parser
+                                                , anyChar
+                                                , char
+                                                , choice
+                                                , many'
+                                                , manyTill
+                                                , parse
+                                                , parseOnly
+                                                , sepBy
+                                                , skipMany
+                                                , skipSpace
+                                                , skipWhile
+                                                , space
+                                                , string
+                                                , takeTill
+                                                , takeWhile1
+                                                )
+import           Data.Char                      ( isAlpha
+                                                , isAlphaNum
+                                                )
+import qualified Data.HashMap.Lazy             as HM
+import           Data.Maybe                     ( catMaybes )
+import qualified Data.Text                     as T
+import           Data.Text                      ( Text )
+import           GHC.Generics                   ( Generic )
+import           Servall.Types
+
+parseWikiTemplates :: Text -> Either String [WikiTemplate]
+parseWikiTemplates = parseOnly wikiP
+
+wikiP :: Parser [WikiTemplate]
+wikiP = sepBy templateP (commentP <|> skipSpace)
+
+templateP :: Parser WikiTemplate
+templateP = do
+  string "{{"
+  name   <- tempHeaderP
+  fields <- many' (choice [tempFieldP, commentP >> return Nothing])
+  string "}}"
+  return $ WikiTemplate name (HM.fromList (catMaybes fields))
+
+tempHeaderP :: Parser Text
+tempHeaderP = do
+  -- Not sure whether name can contain numbers
+  skipSpace
+  -- Does not consider multiple words like Short description
+  name <- takeWhile1 isAlpha
+  manyTill anyChar (lookAhead ((char '|' >> return "") <|> string "}}"))
+  return name
+
+tempFieldP :: Parser (Maybe (Text, Text))
+tempFieldP = do
+  skipSpace >> char '|' >> skipSpace
+  choice [namedField, tempFieldValueP >> return Nothing]
+ where
+  namedField = do
+    key <- takeWhile1 (\c -> isAlphaNum c || c == '_')
+    skipSpace
+    char '='
+    skipSpace
+    value <- tempFieldValueP
+    return $ if T.null value then Nothing else Just (key, value)
+
+tempFieldValueP :: Parser Text
+tempFieldValueP = do
+  skipSpace
+  T.concat <$> many'
+    (choice [templateP >> return "", commentP >> return "", wikilinkP, simpleP])
+ where
+  simpleP :: Parser Text
+  simpleP = do
+    t <- T.pack <$> manyTill
+      anyChar
+      (lookAhead
+        (   string "[["
+        <|> string "{{"
+        <|> string "<!--"
+        <|> (char '|' >> return "")
+        <|> string "}}"
+        )
+      )
+    if T.null t then fail "simpleP" else return $ T.unwords $ T.words t
+
+commentP :: Parser ()
+commentP = do
+  skipSpace >> string "<!--" >> untilCommentEnd ""
+ where
+  untilCommentEnd :: Text -> Parser ()
+  untilCommentEnd xs | T.isSuffixOf "--" xs = char '>' >> return ()
+  untilCommentEnd _                         = do
+    xs <- takeWhile1 (/= '>')
+    untilCommentEnd xs
+
+wikilinkP :: Parser Text
+wikilinkP = do
+  beg     <- string "[["
+  content <- T.pack <$> manyTill anyChar (string "]]")
+  return $ beg <> content <> "]]"