separating out wikiparser and types and added config

1 files changed, 46 insertions, 106 deletions

diff --git a/app/Main.hs b/app/Main.hs
index f4c7afc..7e96dc8 100644
--- a/app/Main.hs
+++ b/app/Main.hs
@@ -4,8 +4,9 @@
 {-# LANGUAGE TypeOperators #-}
 
 module Main where
-
-import           Control.Applicative            ( (<|>) )
+import           Control.Applicative            ( (<**>)
+                                                , (<|>)
+                                                )
 import           Control.Lens                   ( (^.)
                                                 , (^?)
                                                 )
@@ -24,36 +25,13 @@ import           Data.Aeson.Lens                ( AsNumber(..)
                                                 , AsValue(..)
                                                 , key
                                                 )
-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 qualified Data.ByteString.Lazy          as BSL
-import           Data.Char                      ( isAlpha
-                                                , isAlphaNum
-                                                )
 import           Data.Either                    ( fromRight )
 import qualified Data.HashMap.Lazy             as HM
 import           Data.List                      ( find
                                                 , isSuffixOf
                                                 )
-import           Data.Maybe                     ( catMaybes
-                                                , fromJust
-                                                )
+import           Data.Maybe                     ( fromJust )
 import           Data.Proxy                     ( Proxy(..) )
 import qualified Data.Text                     as T
 import           Data.Text                      ( Text )
@@ -64,7 +42,25 @@ import           Network.Wreq                   ( Response
                                                 , get
                                                 , responseBody
                                                 )
+import           Options.Applicative            ( Parser
+                                                , auto
+                                                , execParser
+                                                , fullDesc
+                                                , header
+                                                , help
+                                                , helper
+                                                , info
+                                                , long
+                                                , metavar
+                                                , option
+                                                , progDesc
+                                                , short
+                                                , showDefault
+                                                , value
+                                                )
 import           Prelude                 hiding ( takeWhile )
+import           Servall.Types
+import           Servall.WikiParser             ( parseWikiTemplates )
 import           Servant                        ( (:<|>)(..)
                                                 , (:>)
                                                 , Application
@@ -161,87 +157,9 @@ getInfobox name = do
     HM.empty
     wtFields
     (find (\(WikiTemplate name _) -> name == "Infobox")
-          (fromRight [] (parseOnly wikiP wiki))
+          (fromRight [] (parseWikiTemplates wiki))
     )
 
-wikiP :: Parser [WikiTemplate]
-wikiP = sepBy templateP (commentP <|> skipSpace)
-
-data WikiTemplate = WikiTemplate
-  { wtName   :: Text
-  -- , wtSubName :: Maybe Text
-  , wtFields :: HM.HashMap Text Text
-  }
-  deriving (Show, Generic)
-
-instance ToJSON WikiTemplate
-instance FromJSON WikiTemplate
-
-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 <> "]]"
 
 app :: Application
 app = serve api server
@@ -251,4 +169,26 @@ api = Proxy
 
 main :: IO ()
 main = do
-  run 5555 app
+  config <- execParser opts
+  run (configPort config) app
+ where
+  opts = info
+    (optParser <**> helper)
+    (fullDesc <> progDesc "Servall everything server" <> header
+      "servall - an everything server."
+    )
+
+optParser :: Parser ServerConfig
+optParser = ServerConfig <$> option
+  auto
+  (  long "port"
+  <> short 'p'
+  <> metavar "PORT"
+  <> value 5555
+  <> showDefault
+  <> help "Port to run the server at."
+  )
+
+data ServerConfig = ServerConfig
+  { configPort :: Int
+  }