{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DefaultSignatures #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedLists #-}
{-# LANGUAGE OverloadedRecordDot #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}

module IntelliMonad.Tools.Arxiv where

import qualified Codec.Picture as P
import Control.Monad.Trans.State (StateT)
import Data.Aeson (FromJSON, ToJSON, eitherDecode, encode, (.:))
import qualified Data.Aeson as A
import qualified Data.Aeson.Key as A
import qualified Data.Aeson.KeyMap as A
import qualified Data.ByteString.Char8 as BC
import Data.ByteString (ByteString, fromStrict, toStrict)
import Data.Coerce
import Data.Kind (Type)
import qualified Data.Map as M
import Data.Proxy
import Data.Text (Text)
import qualified Data.Text as T
import qualified Data.Text.Lazy as TL
import qualified Data.Text.Encoding as T
import Data.Time
import qualified Data.Vector as V
import Database.Persist
import Database.Persist.Sqlite
import Database.Persist.TH
import GHC.Generics
import qualified OpenAI.Types as API
-- Import HttpClient to make the REST API call
import Network.HTTP.Client
import Network.HTTP.Client.TLS
import Network.HTTP.Simple (setRequestQueryString)
-- import Network.HTTP.Conduit
import IntelliMonad.Types
import Text.XML
import Text.XML.Cursor (Cursor, attributeIs, content, element, fromDocument, ($//), (&/), (&//), Axis, checkName)
import Control.Exception (SomeException, catch)
import Data.Maybe (mapMaybe, fromMaybe)

data Arxiv = Arxiv
  { Arxiv -> Text
searchQuery :: Text
  , Arxiv -> Maybe Int
maxResults :: Maybe Int
  , Arxiv -> Maybe Int
start :: Maybe Int
  }
  deriving (Arxiv -> Arxiv -> Bool
(Arxiv -> Arxiv -> Bool) -> (Arxiv -> Arxiv -> Bool) -> Eq Arxiv
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Arxiv -> Arxiv -> Bool
== :: Arxiv -> Arxiv -> Bool
$c/= :: Arxiv -> Arxiv -> Bool
/= :: Arxiv -> Arxiv -> Bool
Eq, Int -> Arxiv -> ShowS
[Arxiv] -> ShowS
Arxiv -> String
(Int -> Arxiv -> ShowS)
-> (Arxiv -> String) -> ([Arxiv] -> ShowS) -> Show Arxiv
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Arxiv -> ShowS
showsPrec :: Int -> Arxiv -> ShowS
$cshow :: Arxiv -> String
show :: Arxiv -> String
$cshowList :: [Arxiv] -> ShowS
showList :: [Arxiv] -> ShowS
Show, (forall x. Arxiv -> Rep Arxiv x)
-> (forall x. Rep Arxiv x -> Arxiv) -> Generic Arxiv
forall x. Rep Arxiv x -> Arxiv
forall x. Arxiv -> Rep Arxiv x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Arxiv -> Rep Arxiv x
from :: forall x. Arxiv -> Rep Arxiv x
$cto :: forall x. Rep Arxiv x -> Arxiv
to :: forall x. Rep Arxiv x -> Arxiv
Generic, Schema
Schema -> JSONSchema Arxiv
forall r. Schema -> JSONSchema r
$cschema :: Schema
schema :: Schema
JSONSchema, Maybe Arxiv
Value -> Parser [Arxiv]
Value -> Parser Arxiv
(Value -> Parser Arxiv)
-> (Value -> Parser [Arxiv]) -> Maybe Arxiv -> FromJSON Arxiv
forall a.
(Value -> Parser a)
-> (Value -> Parser [a]) -> Maybe a -> FromJSON a
$cparseJSON :: Value -> Parser Arxiv
parseJSON :: Value -> Parser Arxiv
$cparseJSONList :: Value -> Parser [Arxiv]
parseJSONList :: Value -> Parser [Arxiv]
$comittedField :: Maybe Arxiv
omittedField :: Maybe Arxiv
A.FromJSON, [Arxiv] -> Value
[Arxiv] -> Encoding
Arxiv -> Bool
Arxiv -> Value
Arxiv -> Encoding
(Arxiv -> Value)
-> (Arxiv -> Encoding)
-> ([Arxiv] -> Value)
-> ([Arxiv] -> Encoding)
-> (Arxiv -> Bool)
-> ToJSON Arxiv
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
$ctoJSON :: Arxiv -> Value
toJSON :: Arxiv -> Value
$ctoEncoding :: Arxiv -> Encoding
toEncoding :: Arxiv -> Encoding
$ctoJSONList :: [Arxiv] -> Value
toJSONList :: [Arxiv] -> Value
$ctoEncodingList :: [Arxiv] -> Encoding
toEncodingList :: [Arxiv] -> Encoding
$comitField :: Arxiv -> Bool
omitField :: Arxiv -> Bool
A.ToJSON)

instance HasFunctionObject Arxiv where
  getFunctionName :: String
getFunctionName = String
"search_arxiv"
  getFunctionDescription :: String
getFunctionDescription = String
"Search Arxiv with a keyword"
  getFieldDescription :: ShowS
getFieldDescription String
"searchQuery" = String
"The keyword to search for on Arxiv: This keyword is used as a input of 'http://export.arxiv.org/api/query?search_query='. "
  getFieldDescription String
"maxResults" = String
"The maximum number of results to return. If not specified, the default is 10."
  getFieldDescription String
"start" = String
"The start index of the results. If not specified, the default is 0."

arxivSearch :: Arxiv -> IO ByteString
arxivSearch :: Arxiv -> IO ByteString
arxivSearch Arxiv{Maybe Int
Text
$sel:searchQuery:Arxiv :: Arxiv -> Text
$sel:maxResults:Arxiv :: Arxiv -> Maybe Int
$sel:start:Arxiv :: Arxiv -> Maybe Int
searchQuery :: Text
maxResults :: Maybe Int
start :: Maybe Int
..} = do
  Manager
manager <- ManagerSettings -> IO Manager
newManager ManagerSettings
tlsManagerSettings
  let request :: Request
request = Query -> Request -> Request
setRequestQueryString
                  [ (ByteString
"search_query", ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just (ByteString -> Maybe ByteString) -> ByteString -> Maybe ByteString
forall a b. (a -> b) -> a -> b
$ Text -> ByteString
T.encodeUtf8 Text
searchQuery)
                  , (ByteString
"max_results", ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just (ByteString -> Maybe ByteString) -> ByteString -> Maybe ByteString
forall a b. (a -> b) -> a -> b
$ ByteString -> Maybe ByteString -> ByteString
forall a. a -> Maybe a -> a
fromMaybe ByteString
"10" (String -> ByteString
BC.pack (String -> ByteString) -> (Int -> String) -> Int -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String
forall a. Show a => a -> String
show (Int -> ByteString) -> Maybe Int -> Maybe ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Int
maxResults))
                  , (ByteString
"start", ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just (ByteString -> Maybe ByteString) -> ByteString -> Maybe ByteString
forall a b. (a -> b) -> a -> b
$ ByteString -> Maybe ByteString -> ByteString
forall a. a -> Maybe a -> a
fromMaybe ByteString
"0" (String -> ByteString
BC.pack (String -> ByteString) -> (Int -> String) -> Int -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String
forall a. Show a => a -> String
show (Int -> ByteString) -> Maybe Int -> Maybe ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Int
start))
                  ]
                  Request
"https://export.arxiv.org/api/query"
  Response ByteString
response <- Request -> Manager -> IO (Response ByteString)
httpLbs Request
request Manager
manager
  ByteString -> IO ByteString
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString -> IO ByteString) -> ByteString -> IO ByteString
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
toStrict (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ Response ByteString -> ByteString
forall body. Response body -> body
responseBody Response ByteString
response

element' :: Text -> Axis
element' :: Text -> Axis
element' Text
name = (Name -> Bool) -> Axis
forall b. Boolean b => (Name -> b) -> Axis
checkName (\Name
n ->  Name -> Text
nameLocalName Name
n Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
name)

queryArxiv :: Arxiv -> IO [ArxivEntry]
queryArxiv :: Arxiv -> IO [ArxivEntry]
queryArxiv Arxiv
keyword = do
  ByteString
jsonSource <- Arxiv -> IO ByteString
arxivSearch Arxiv
keyword :: IO ByteString
  [ArxivEntry] -> IO [ArxivEntry]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ([ArxivEntry] -> IO [ArxivEntry])
-> [ArxivEntry] -> IO [ArxivEntry]
forall a b. (a -> b) -> a -> b
$ ByteString -> [ArxivEntry]
parseArxivXML ByteString
jsonSource

data ArxivEntry = ArxivEntry
  { ArxivEntry -> Text
arxivId   :: Text
  , ArxivEntry -> Text
published :: Text
  , ArxivEntry -> Text
title     :: Text
  , ArxivEntry -> Text
summary   :: Text
  } deriving (ArxivEntry -> ArxivEntry -> Bool
(ArxivEntry -> ArxivEntry -> Bool)
-> (ArxivEntry -> ArxivEntry -> Bool) -> Eq ArxivEntry
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ArxivEntry -> ArxivEntry -> Bool
== :: ArxivEntry -> ArxivEntry -> Bool
$c/= :: ArxivEntry -> ArxivEntry -> Bool
/= :: ArxivEntry -> ArxivEntry -> Bool
Eq, Int -> ArxivEntry -> ShowS
[ArxivEntry] -> ShowS
ArxivEntry -> String
(Int -> ArxivEntry -> ShowS)
-> (ArxivEntry -> String)
-> ([ArxivEntry] -> ShowS)
-> Show ArxivEntry
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ArxivEntry -> ShowS
showsPrec :: Int -> ArxivEntry -> ShowS
$cshow :: ArxivEntry -> String
show :: ArxivEntry -> String
$cshowList :: [ArxivEntry] -> ShowS
showList :: [ArxivEntry] -> ShowS
Show, (forall x. ArxivEntry -> Rep ArxivEntry x)
-> (forall x. Rep ArxivEntry x -> ArxivEntry) -> Generic ArxivEntry
forall x. Rep ArxivEntry x -> ArxivEntry
forall x. ArxivEntry -> Rep ArxivEntry x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ArxivEntry -> Rep ArxivEntry x
from :: forall x. ArxivEntry -> Rep ArxivEntry x
$cto :: forall x. Rep ArxivEntry x -> ArxivEntry
to :: forall x. Rep ArxivEntry x -> ArxivEntry
Generic, Maybe ArxivEntry
Value -> Parser [ArxivEntry]
Value -> Parser ArxivEntry
(Value -> Parser ArxivEntry)
-> (Value -> Parser [ArxivEntry])
-> Maybe ArxivEntry
-> FromJSON ArxivEntry
forall a.
(Value -> Parser a)
-> (Value -> Parser [a]) -> Maybe a -> FromJSON a
$cparseJSON :: Value -> Parser ArxivEntry
parseJSON :: Value -> Parser ArxivEntry
$cparseJSONList :: Value -> Parser [ArxivEntry]
parseJSONList :: Value -> Parser [ArxivEntry]
$comittedField :: Maybe ArxivEntry
omittedField :: Maybe ArxivEntry
A.FromJSON, [ArxivEntry] -> Value
[ArxivEntry] -> Encoding
ArxivEntry -> Bool
ArxivEntry -> Value
ArxivEntry -> Encoding
(ArxivEntry -> Value)
-> (ArxivEntry -> Encoding)
-> ([ArxivEntry] -> Value)
-> ([ArxivEntry] -> Encoding)
-> (ArxivEntry -> Bool)
-> ToJSON ArxivEntry
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
$ctoJSON :: ArxivEntry -> Value
toJSON :: ArxivEntry -> Value
$ctoEncoding :: ArxivEntry -> Encoding
toEncoding :: ArxivEntry -> Encoding
$ctoJSONList :: [ArxivEntry] -> Value
toJSONList :: [ArxivEntry] -> Value
$ctoEncodingList :: [ArxivEntry] -> Encoding
toEncodingList :: [ArxivEntry] -> Encoding
$comitField :: ArxivEntry -> Bool
omitField :: ArxivEntry -> Bool
A.ToJSON)

headDef :: a -> [a] -> a
headDef :: forall a. a -> [a] -> a
headDef a
d [] = a
d
headDef a
_ (a
x:[a]
_) = a
x

-- | Parser for an Arxiv Entry in XML
parseEntry :: Cursor -> Maybe ArxivEntry
parseEntry :: Cursor -> Maybe ArxivEntry
parseEntry Cursor
c =
  let arxivId :: Text
arxivId   = Text -> [Text] -> Text
forall a. a -> [a] -> a
headDef Text
"" ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ Cursor
c Cursor -> (Cursor -> [Text]) -> [Text]
forall node a. Cursor node -> (Cursor node -> [a]) -> [a]
$// Text -> Axis
element' Text
"id" Axis -> (Cursor -> [Text]) -> Cursor -> [Text]
forall node a.
Axis node -> (Cursor node -> [a]) -> Cursor node -> [a]
&/ Cursor -> [Text]
content
      published :: Text
published = Text -> [Text] -> Text
forall a. a -> [a] -> a
headDef Text
"" ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ Cursor
c Cursor -> (Cursor -> [Text]) -> [Text]
forall node a. Cursor node -> (Cursor node -> [a]) -> [a]
$// Text -> Axis
element' Text
"published" Axis -> (Cursor -> [Text]) -> Cursor -> [Text]
forall node a.
Axis node -> (Cursor node -> [a]) -> Cursor node -> [a]
&/ Cursor -> [Text]
content
      title :: Text
title     = Text -> [Text] -> Text
forall a. a -> [a] -> a
headDef Text
"" ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ Cursor
c Cursor -> (Cursor -> [Text]) -> [Text]
forall node a. Cursor node -> (Cursor node -> [a]) -> [a]
$// Text -> Axis
element' Text
"title" Axis -> (Cursor -> [Text]) -> Cursor -> [Text]
forall node a.
Axis node -> (Cursor node -> [a]) -> Cursor node -> [a]
&/ Cursor -> [Text]
content
      summary :: Text
summary   = Text -> [Text] -> Text
forall a. a -> [a] -> a
headDef Text
"" ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ Cursor
c Cursor -> (Cursor -> [Text]) -> [Text]
forall node a. Cursor node -> (Cursor node -> [a]) -> [a]
$// Text -> Axis
element' Text
"summary" Axis -> (Cursor -> [Text]) -> Cursor -> [Text]
forall node a.
Axis node -> (Cursor node -> [a]) -> Cursor node -> [a]
&/ Cursor -> [Text]
content
  in  ArxivEntry -> Maybe ArxivEntry
forall a. a -> Maybe a
Just (ArxivEntry -> Maybe ArxivEntry) -> ArxivEntry -> Maybe ArxivEntry
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Text -> Text -> ArxivEntry
ArxivEntry Text
arxivId Text
published Text
title Text
summary

-- | Parser for an Arxiv Result in XML
parseArxivResult :: Cursor -> [ArxivEntry]
parseArxivResult :: Cursor -> [ArxivEntry]
parseArxivResult Cursor
c = (Cursor -> Maybe ArxivEntry) -> [Cursor] -> [ArxivEntry]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe Cursor -> Maybe ArxivEntry
parseEntry (Cursor
c Cursor -> Axis -> [Cursor]
forall node a. Cursor node -> (Cursor node -> [a]) -> [a]
$// Text -> Axis
element' Text
"entry")

parseArxivXML :: ByteString -> [ArxivEntry]
parseArxivXML :: ByteString -> [ArxivEntry]
parseArxivXML ByteString
xml =
  case ParseSettings -> Text -> Either SomeException Document
parseText ParseSettings
forall a. Default a => a
def (Text -> Text
TL.fromStrict (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ ByteString -> Text
T.decodeUtf8 ByteString
xml) of
    Left SomeException
_ -> []
    Right Document
v -> Cursor -> [ArxivEntry]
parseArxivResult (Cursor -> [ArxivEntry]) -> Cursor -> [ArxivEntry]
forall a b. (a -> b) -> a -> b
$ Document -> Cursor
fromDocument Document
v

instance Tool Arxiv where
  data Output Arxiv = ArxivOutput
    { Output Arxiv -> [ArxivEntry]
papers :: [ArxivEntry]
    }
    deriving (Output Arxiv -> Output Arxiv -> Bool
(Output Arxiv -> Output Arxiv -> Bool)
-> (Output Arxiv -> Output Arxiv -> Bool) -> Eq (Output Arxiv)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Output Arxiv -> Output Arxiv -> Bool
== :: Output Arxiv -> Output Arxiv -> Bool
$c/= :: Output Arxiv -> Output Arxiv -> Bool
/= :: Output Arxiv -> Output Arxiv -> Bool
Eq, Int -> Output Arxiv -> ShowS
[Output Arxiv] -> ShowS
Output Arxiv -> String
(Int -> Output Arxiv -> ShowS)
-> (Output Arxiv -> String)
-> ([Output Arxiv] -> ShowS)
-> Show (Output Arxiv)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Output Arxiv -> ShowS
showsPrec :: Int -> Output Arxiv -> ShowS
$cshow :: Output Arxiv -> String
show :: Output Arxiv -> String
$cshowList :: [Output Arxiv] -> ShowS
showList :: [Output Arxiv] -> ShowS
Show, (forall x. Output Arxiv -> Rep (Output Arxiv) x)
-> (forall x. Rep (Output Arxiv) x -> Output Arxiv)
-> Generic (Output Arxiv)
forall x. Rep (Output Arxiv) x -> Output Arxiv
forall x. Output Arxiv -> Rep (Output Arxiv) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Output Arxiv -> Rep (Output Arxiv) x
from :: forall x. Output Arxiv -> Rep (Output Arxiv) x
$cto :: forall x. Rep (Output Arxiv) x -> Output Arxiv
to :: forall x. Rep (Output Arxiv) x -> Output Arxiv
Generic, Maybe (Output Arxiv)
Value -> Parser [Output Arxiv]
Value -> Parser (Output Arxiv)
(Value -> Parser (Output Arxiv))
-> (Value -> Parser [Output Arxiv])
-> Maybe (Output Arxiv)
-> FromJSON (Output Arxiv)
forall a.
(Value -> Parser a)
-> (Value -> Parser [a]) -> Maybe a -> FromJSON a
$cparseJSON :: Value -> Parser (Output Arxiv)
parseJSON :: Value -> Parser (Output Arxiv)
$cparseJSONList :: Value -> Parser [Output Arxiv]
parseJSONList :: Value -> Parser [Output Arxiv]
$comittedField :: Maybe (Output Arxiv)
omittedField :: Maybe (Output Arxiv)
A.FromJSON, [Output Arxiv] -> Value
[Output Arxiv] -> Encoding
Output Arxiv -> Bool
Output Arxiv -> Value
Output Arxiv -> Encoding
(Output Arxiv -> Value)
-> (Output Arxiv -> Encoding)
-> ([Output Arxiv] -> Value)
-> ([Output Arxiv] -> Encoding)
-> (Output Arxiv -> Bool)
-> ToJSON (Output Arxiv)
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
$ctoJSON :: Output Arxiv -> Value
toJSON :: Output Arxiv -> Value
$ctoEncoding :: Output Arxiv -> Encoding
toEncoding :: Output Arxiv -> Encoding
$ctoJSONList :: [Output Arxiv] -> Value
toJSONList :: [Output Arxiv] -> Value
$ctoEncodingList :: [Output Arxiv] -> Encoding
toEncodingList :: [Output Arxiv] -> Encoding
$comitField :: Output Arxiv -> Bool
omitField :: Output Arxiv -> Bool
A.ToJSON)

  toolExec :: Arxiv -> IO (Output Arxiv)
toolExec Arxiv
args = do
    [ArxivEntry]
papers <- Arxiv -> IO [ArxivEntry]
queryArxiv Arxiv
args
    Output Arxiv -> IO (Output Arxiv)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Output Arxiv -> IO (Output Arxiv))
-> Output Arxiv -> IO (Output Arxiv)
forall a b. (a -> b) -> a -> b
$ [ArxivEntry] -> Output Arxiv
ArxivOutput [ArxivEntry]
papers