{-# LANGUAGE DataKinds #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeOperators #-}

module Main where
import           Control.Applicative            ( (<**>)
                                                , (<|>)
                                                )
import           Control.Lens                   ( (^.)
                                                , (^?)
                                                )
import           Control.Monad.IO.Class         ( liftIO )
import           Data.Aeson                     ( (.:)
                                                , (.=)
                                                , FromJSON(..)
                                                , ToJSON(..)
                                                , Value(..)
                                                , decode
                                                , encode
                                                , object
                                                )
import qualified Data.Aeson.KeyMap             as KM
                                                ( KeyMap
                                                , lookup
                                                )
import           Data.Aeson.Lens                ( AsNumber(..)
                                                , AsValue(..)
                                                , key
                                                )
import qualified Data.ByteString               as BS
import qualified Data.ByteString.Lazy.Char8    as BSL
import           Data.Either                    ( fromRight )
import qualified Data.HashMap.Lazy             as HM
import           Data.List                      ( find
                                                , isSuffixOf
                                                )
import           Data.Maybe                     ( catMaybes
                                                , fromJust
                                                )
import           Data.Proxy                     ( Proxy(..) )
import qualified Data.Text                     as T
import           Data.Text                      ( Text )
import qualified Data.Text.Encoding            as TE
import           Data.Text.IO                   ( hGetContents )
import           Network.Wai.Handler.Warp       ( run )
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
                                                , wikiFilter
                                                )
import           Servant                        ( (:<|>)(..)
                                                , (:>)
                                                , Application
                                                , Capture
                                                , FromHttpApiData(..)
                                                , Get
                                                , Handler
                                                , JSON
                                                , PlainText
                                                , Server
                                                , serve
                                                )
import           System.Process                 ( CreateProcess(..)
                                                , StdStream(..)
                                                , createProcess
                                                , proc
                                                )
import           Text.Pandoc                    ( ReaderOptions(..)
                                                , WrapOption(..)
                                                , WriterOptions(..)
                                                , def
                                                , readMediaWiki
                                                , runIOorExplode
                                                , writeNative
                                                , writeOrg
                                                )
import           Text.Regex.TDFA                ( (=~) )

type API = Wikipedia :<|> Ytdl

type Wikipedia
  = SearchWikipedia :<|> GetWikiFormat :<|> GetOrgFormat :<|> GetPandocFormat :<|> GetWpSummary :<|> GetInfobox

type Ytdl = YtSearch

-- TODO: fix the problem with plaintext having the wront content-type: text/plain
type SearchWikipedia
  = "wikipedia" :> "search" :> Capture "query" Text :> Get '[PlainText] Text

type GetWikiFormat
  = "wikipedia" :> "wiki" :> Capture "name" Text :> Get '[JSON] Text

type GetOrgFormat
  = "wikipedia" :> "org" :> Capture "name" Text :> Get '[JSON] Text

type GetPandocFormat
  = "wikipedia" :> "pandoc" :> Capture "name" Text :> Get '[JSON] Text

type GetWpSummary
  = "wikipedia" :> "summary" :> Capture "name" Text :> Get '[JSON] WikiSummary

type GetInfobox
  = "wikipedia" :> "infobox" :> Capture "name" Text :> Get '[JSON] (HM.HashMap Text Text)

type YtSearch
  = "ytdl" :> "search" :> Capture "query" Text :> Get '[JSON] [Video]

server :: Server API
server =
  (    searchWikipedia
    :<|> getWikiFormat
    :<|> getOrgFormat
    :<|> getPandocFormat
    :<|> getWpSummary
    :<|> getInfobox
    )
    :<|> searchYt

searchWikipedia :: Text -> Handler Text
searchWikipedia query = do
  r <- liftIO $ get
    ("https://en.wikipedia.org/w/api.php?action=query&format=json&list=search&srsearch="
    <> (T.unpack query)
    )
  return $ TE.decodeUtf8 $ BSL.toStrict $ r ^. responseBody

getWikiFormat :: Text -> Handler Text
getWikiFormat name = do
  r <- liftIO $ get
    ("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
  WikiSummary title _ _ <- getWpSummary name
  liftIO
    $   runIOorExplode
    $   (wikiFilter title <$> readMediaWiki def wiki)
    >>= writeOrg def { writerWrapText = WrapNone }

getPandocFormat :: Text -> Handler Text
getPandocFormat name = do
  wiki <- getWikiFormat name
  liftIO $ runIOorExplode $ readMediaWiki def wiki >>= writeNative def
    { writerWrapText = WrapNone
    }

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
  wiki <- getWikiFormat name
  return $ maybe
    HM.empty
    wtFields
    (find (\(WikiTemplate name _) -> name == "Infobox")
          (fromRight [] (parseWikiTemplates wiki))
    )

searchYt :: Text -> Handler [Video]
searchYt query = do
  (_, Just hout, _, _) <- liftIO $ createProcess
    (proc "yt-dlp" ["-j", "ytsearch10:" <> T.unpack query])
      { std_out = CreatePipe
      }
  liftIO $ (catMaybes . map decode . BSL.lines) <$> BSL.hGetContents hout

app :: Application
app = serve api server

api :: Proxy API
api = Proxy

main :: IO ()
main = do
  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
  }