diff options
| -rw-r--r-- | app/Main.hs | 32 | ||||
| -rw-r--r-- | src/Servall/Types.hs | 21 | ||||
| -rw-r--r-- | src/Servall/WikiParser.hs | 13 |
3 files changed, 47 insertions, 19 deletions
diff --git a/app/Main.hs b/app/Main.hs index 0368b77..6ddae49 100644 --- a/app/Main.hs +++ b/app/Main.hs @@ -1,4 +1,3 @@ -{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE DataKinds #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TypeOperators #-} @@ -43,7 +42,6 @@ import qualified Data.Text as T import Data.Text ( Text ) import qualified Data.Text.Encoding as TE import Data.Text.IO ( hGetContents ) -import GHC.Generics ( Generic ) import Network.Wai.Handler.Warp ( run ) import Network.Wreq ( Response , get @@ -87,7 +85,8 @@ import System.Process ( CreateProcess(..) , createProcess , proc ) -import Text.Pandoc ( WrapOption(..) +import Text.Pandoc ( ReaderOptions(..) + , WrapOption(..) , WriterOptions(..) , def , readMediaWiki @@ -118,7 +117,7 @@ type GetPandocFormat = "wikipedia" :> "pandoc" :> Capture "name" Text :> Get '[JSON] Text type GetWpSummary - = "wikipedia" :> "summary" :> Capture "name" Text :> Get '[PlainText] Text + = "wikipedia" :> "summary" :> Capture "name" Text :> Get '[JSON] WikiSummary type GetInfobox = "wikipedia" :> "infobox" :> Capture "name" Text :> Get '[JSON] (HM.HashMap Text Text) @@ -151,12 +150,18 @@ getWikiFormat name = do ("https://en.wikipedia.org/wiki/" <> (T.unpack name) <> "?action=raw") return $ TE.decodeUtf8 $ BSL.toStrict $ r ^. responseBody +getHtmlFormat :: Text -> Handler Text +getHtmlFormat name = do + r <- liftIO $ get ("https://en.wikipedia.org/wiki/" <> (T.unpack name)) + return $ TE.decodeUtf8 $ BSL.toStrict $ r ^. responseBody + getOrgFormat :: Text -> Handler Text getOrgFormat name = do - wiki <- getWikiFormat name + wiki <- getWikiFormat name + WikiSummary title _ _ <- getWpSummary name liftIO $ runIOorExplode - $ (wikiFilter <$> readMediaWiki def wiki) + $ (wikiFilter title <$> readMediaWiki def wiki) >>= writeOrg def { writerWrapText = WrapNone } getPandocFormat :: Text -> Handler Text @@ -166,11 +171,16 @@ getPandocFormat name = do { writerWrapText = WrapNone } -getWpSummary :: Text -> Handler Text -getWpSummary name = do - r <- liftIO $ get - ("https://en.wikipedia.org/api/rest_v1/page/summary/" <> (T.unpack name)) - return $ TE.decodeUtf8 $ BSL.toStrict $ r ^. responseBody +getWpSummary :: Text -> Handler WikiSummary +getWpSummary name = fmap (fromJust . decode) (liftIO $ getApiWpSummary name) + +getApiWpSummary :: Text -> IO BSL.ByteString +getApiWpSummary name = (^. responseBody) <$> get + ("https://en.wikipedia.org/api/rest_v1/page/summary/" <> (T.unpack name)) + +getWpSummaryFull :: Text -> Handler Text +getWpSummaryFull name = + fmap (TE.decodeUtf8 . BSL.toStrict) (liftIO $ getApiWpSummary name) getInfobox :: Text -> Handler (HM.HashMap Text Text) getInfobox name = do diff --git a/src/Servall/Types.hs b/src/Servall/Types.hs index 69c2045..794482c 100644 --- a/src/Servall/Types.hs +++ b/src/Servall/Types.hs @@ -1,8 +1,6 @@ +{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE OverloadedStrings #-} -module Servall.Types - ( WikiTemplate(..) - , Video(..) - ) where +module Servall.Types where import Data.Aeson ( (.:) , (.=) @@ -13,6 +11,7 @@ import Data.Aeson ( (.:) ) import qualified Data.HashMap.Lazy as HM import Data.Text ( Text ) +import GHC.Generics ( Generic ) data WikiTemplate = WikiTemplate { wtName :: Text @@ -48,3 +47,17 @@ instance ToJSON Video where , "description" .= desc , "duration" .= duration ] + + +data WikiSummary = WikiSummary + { wsTitle :: Text + , wsWikbase :: Text + , wsPageId :: Int + } + deriving (Show, Eq, Generic) + +instance FromJSON WikiSummary where + parseJSON (Object o) = + WikiSummary <$> o .: "title" <*> o .: "wikibase_item" <*> o .: "pageid" + +instance ToJSON WikiSummary diff --git a/src/Servall/WikiParser.hs b/src/Servall/WikiParser.hs index 2680fad..e284a3b 100644 --- a/src/Servall/WikiParser.hs +++ b/src/Servall/WikiParser.hs @@ -32,8 +32,9 @@ 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.Definition ( Block(..) + , Inline(..) + , Pandoc(..) ) import Text.Pandoc.Generic ( topDown ) @@ -109,8 +110,12 @@ wikilinkP = do content <- T.pack <$> manyTill anyChar (string "]]") return $ beg <> content <> "]]" -wikiFilter :: Pandoc -> Pandoc -wikiFilter = topDown fixUrl +wikiFilter :: Text -> Pandoc -> Pandoc +wikiFilter title = insertHeader title . topDown fixUrl + +insertHeader :: Text -> Pandoc -> Pandoc +insertHeader title (Pandoc m bs) = + Pandoc m (Header 1 ("", [], []) [Str title] : bs) fixUrl :: Inline -> Inline fixUrl (Link attr label (url, "wikilink")) = |