{-# language DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE OverloadedStrings #-}
{-# options_ghc -Wno-unused-imports -Wno-unused-top-binds #-}
-- | Citeseer document classification dataset, from :
--
-- Qing Lu, and Lise Getoor. "Link-based classification." ICML, 2003.
--
-- https://linqs.soe.ucsc.edu/data
--
-- The dataset consists of 3312 scientific publications classified into one of six classes. The citation network consists of 4732 links. Each publication in the dataset is described by a 0\/1-valued word vector indicating the absence\/presence of the corresponding word from the dictionary. The dictionary consists of 3703 unique words.
module Algebra.Graph.IO.Datasets.LINQS.Citeseer (
  -- * 1. Download the dataset
  stash
  -- * 2. Reconstruct the citation graph
  , sourceCiteseerGraphEdges, loadCiteseerGraph
  -- * Types
    ,CiteSeerDoc(..)) where

import Control.Applicative (Alternative(..))
import Control.Monad (when, foldM)
import Control.Monad.IO.Class (MonadIO(..))
import GHC.Generics (Generic(..))
import GHC.Int (Int16)
import Data.Functor (($>))

-- algebraic-graphs
import qualified Algebra.Graph as G (Graph, empty, overlay, edge)
-- binary
import Data.Binary (Binary(..), encode, decode, encodeFile, decodeFileOrFail)
-- binary-conduit
import qualified Data.Conduit.Serialization.Binary as CB (conduitDecode, conduitEncode, ParseError(..))
-- bytestring
import Data.ByteString (ByteString)
import Data.ByteString.Char8 (unpack)
-- conduit
import Conduit (MonadUnliftIO(..), MonadResource, runResourceT)
import Data.Conduit (runConduit, ConduitT, (.|), yield, await)
import qualified Data.Conduit.Combinators as C (print, sourceFile, sinkFile, map, mapM, foldM, foldMap, foldl, foldMapM, mapWhile)
-- containers
import Data.Sequence (Seq, (|>))
import qualified Data.Map as M (Map, singleton, lookup)
-- directory
import System.Directory (createDirectoryIfMissing)
-- exceptions
import Control.Monad.Catch (MonadThrow(..))
-- filepath
import System.FilePath ((</>), takeFileName, takeExtension)
-- http-conduit
import Network.HTTP.Simple (httpSource, getResponseBody, Response, Request, parseRequest, setRequestMethod)
-- megaparsec
import Text.Megaparsec (parse, parseTest, (<?>))
import Text.Megaparsec.Char (char)
import Text.Megaparsec.Char.Lexer (decimal)
import Text.Megaparsec.Error (errorBundlePretty)
-- parser.combinators
import Control.Monad.Combinators (count)
-- primitive
import Control.Monad.Primitive (PrimMonad(..))
-- tar-conduit
import Data.Conduit.Tar (Header(..), untarChunks, TarChunk, withEntries, FileInfo, filePath, withFileInfo, headerFileType, FileType(..), headerFilePath)
-- text
import qualified Data.Text as T (Text, unwords)
import qualified Data.Text.IO as T (readFile)

import Algebra.Graph.IO.Internal.Conduit (fetch, unTarGz)
import Algebra.Graph.IO.Internal.Megaparsec (Parser, ParseE, symbol, lexeme, alphaNum)
import Algebra.Graph.IO.SV (parseTSV)
import qualified Algebra.Graph.IO.Datasets.LINQS as DL (stash, sourceGraphEdges, loadGraph, restoreContent, CitesRow(..), ContentRow(..))
{-
CiteSeer: The CiteSeer dataset consists of 3312 scientific publications classified into one of six classes. The citation network consists of 4732 links. Each publication in the dataset is described by a 0/1-valued word vector indicating the absence/presence of the corresponding word from the dictionary. The dictionary consists of 3703 unique words. The README file in the dataset provides more details.
-}

-- | See `DL.stash`
stash :: FilePath -- ^ directory where the data files will be saved
      -> IO ()
stash :: FilePath -> IO ()
stash FilePath
fp = FilePath -> FilePath -> Int -> Parser CiteSeerDoc -> IO ()
forall c.
Binary c =>
FilePath -> FilePath -> Int -> Parser c -> IO ()
DL.stash FilePath
fp FilePath
"http://www.cs.umd.edu/~sen/lbc-proj/data/citeseer.tgz" Int
3703 Parser CiteSeerDoc
docClassP

-- | See `DL.sourceGraphEdges`
sourceCiteseerGraphEdges :: (MonadResource m, MonadThrow m) =>
                      FilePath -- ^ directory of data files
                   -> M.Map String (Int16, Seq Int16, CiteSeerDoc) -- ^ 'content' data
                   -> ConduitT i (Maybe (G.Graph (DL.ContentRow Int16 CiteSeerDoc))) m ()
sourceCiteseerGraphEdges :: FilePath
-> Map FilePath (Int16, Seq Int16, CiteSeerDoc)
-> ConduitT i (Maybe (Graph (ContentRow Int16 CiteSeerDoc))) m ()
sourceCiteseerGraphEdges = FilePath
-> Map FilePath (Int16, Seq Int16, CiteSeerDoc)
-> ConduitT i (Maybe (Graph (ContentRow Int16 CiteSeerDoc))) m ()
forall (m :: * -> *) c i.
(MonadResource m, MonadThrow m) =>
FilePath
-> Map FilePath (Int16, Seq Int16, c)
-> ConduitT i (Maybe (Graph (ContentRow Int16 c))) m ()
DL.sourceGraphEdges

-- | See `DL.loadGraph`
loadCiteseerGraph :: -- (Binary ix) => 
                     FilePath -- ^ directory where the data files were saved
                  -> IO (G.Graph (DL.ContentRow Int16 CiteSeerDoc))
loadCiteseerGraph :: FilePath -> IO (Graph (ContentRow Int16 CiteSeerDoc))
loadCiteseerGraph = FilePath -> IO (Graph (ContentRow Int16 CiteSeerDoc))
forall c. Binary c => FilePath -> IO (Graph (ContentRow Int16 c))
DL.loadGraph

-- | document classes of the Citeseer dataset
data CiteSeerDoc = Agents | AI | DB | IR | ML | HCI deriving (CiteSeerDoc -> CiteSeerDoc -> Bool
(CiteSeerDoc -> CiteSeerDoc -> Bool)
-> (CiteSeerDoc -> CiteSeerDoc -> Bool) -> Eq CiteSeerDoc
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CiteSeerDoc -> CiteSeerDoc -> Bool
$c/= :: CiteSeerDoc -> CiteSeerDoc -> Bool
== :: CiteSeerDoc -> CiteSeerDoc -> Bool
$c== :: CiteSeerDoc -> CiteSeerDoc -> Bool
Eq, Eq CiteSeerDoc
Eq CiteSeerDoc
-> (CiteSeerDoc -> CiteSeerDoc -> Ordering)
-> (CiteSeerDoc -> CiteSeerDoc -> Bool)
-> (CiteSeerDoc -> CiteSeerDoc -> Bool)
-> (CiteSeerDoc -> CiteSeerDoc -> Bool)
-> (CiteSeerDoc -> CiteSeerDoc -> Bool)
-> (CiteSeerDoc -> CiteSeerDoc -> CiteSeerDoc)
-> (CiteSeerDoc -> CiteSeerDoc -> CiteSeerDoc)
-> Ord CiteSeerDoc
CiteSeerDoc -> CiteSeerDoc -> Bool
CiteSeerDoc -> CiteSeerDoc -> Ordering
CiteSeerDoc -> CiteSeerDoc -> CiteSeerDoc
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: CiteSeerDoc -> CiteSeerDoc -> CiteSeerDoc
$cmin :: CiteSeerDoc -> CiteSeerDoc -> CiteSeerDoc
max :: CiteSeerDoc -> CiteSeerDoc -> CiteSeerDoc
$cmax :: CiteSeerDoc -> CiteSeerDoc -> CiteSeerDoc
>= :: CiteSeerDoc -> CiteSeerDoc -> Bool
$c>= :: CiteSeerDoc -> CiteSeerDoc -> Bool
> :: CiteSeerDoc -> CiteSeerDoc -> Bool
$c> :: CiteSeerDoc -> CiteSeerDoc -> Bool
<= :: CiteSeerDoc -> CiteSeerDoc -> Bool
$c<= :: CiteSeerDoc -> CiteSeerDoc -> Bool
< :: CiteSeerDoc -> CiteSeerDoc -> Bool
$c< :: CiteSeerDoc -> CiteSeerDoc -> Bool
compare :: CiteSeerDoc -> CiteSeerDoc -> Ordering
$ccompare :: CiteSeerDoc -> CiteSeerDoc -> Ordering
$cp1Ord :: Eq CiteSeerDoc
Ord, Int -> CiteSeerDoc
CiteSeerDoc -> Int
CiteSeerDoc -> [CiteSeerDoc]
CiteSeerDoc -> CiteSeerDoc
CiteSeerDoc -> CiteSeerDoc -> [CiteSeerDoc]
CiteSeerDoc -> CiteSeerDoc -> CiteSeerDoc -> [CiteSeerDoc]
(CiteSeerDoc -> CiteSeerDoc)
-> (CiteSeerDoc -> CiteSeerDoc)
-> (Int -> CiteSeerDoc)
-> (CiteSeerDoc -> Int)
-> (CiteSeerDoc -> [CiteSeerDoc])
-> (CiteSeerDoc -> CiteSeerDoc -> [CiteSeerDoc])
-> (CiteSeerDoc -> CiteSeerDoc -> [CiteSeerDoc])
-> (CiteSeerDoc -> CiteSeerDoc -> CiteSeerDoc -> [CiteSeerDoc])
-> Enum CiteSeerDoc
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: CiteSeerDoc -> CiteSeerDoc -> CiteSeerDoc -> [CiteSeerDoc]
$cenumFromThenTo :: CiteSeerDoc -> CiteSeerDoc -> CiteSeerDoc -> [CiteSeerDoc]
enumFromTo :: CiteSeerDoc -> CiteSeerDoc -> [CiteSeerDoc]
$cenumFromTo :: CiteSeerDoc -> CiteSeerDoc -> [CiteSeerDoc]
enumFromThen :: CiteSeerDoc -> CiteSeerDoc -> [CiteSeerDoc]
$cenumFromThen :: CiteSeerDoc -> CiteSeerDoc -> [CiteSeerDoc]
enumFrom :: CiteSeerDoc -> [CiteSeerDoc]
$cenumFrom :: CiteSeerDoc -> [CiteSeerDoc]
fromEnum :: CiteSeerDoc -> Int
$cfromEnum :: CiteSeerDoc -> Int
toEnum :: Int -> CiteSeerDoc
$ctoEnum :: Int -> CiteSeerDoc
pred :: CiteSeerDoc -> CiteSeerDoc
$cpred :: CiteSeerDoc -> CiteSeerDoc
succ :: CiteSeerDoc -> CiteSeerDoc
$csucc :: CiteSeerDoc -> CiteSeerDoc
Enum, Int -> CiteSeerDoc -> ShowS
[CiteSeerDoc] -> ShowS
CiteSeerDoc -> FilePath
(Int -> CiteSeerDoc -> ShowS)
-> (CiteSeerDoc -> FilePath)
-> ([CiteSeerDoc] -> ShowS)
-> Show CiteSeerDoc
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [CiteSeerDoc] -> ShowS
$cshowList :: [CiteSeerDoc] -> ShowS
show :: CiteSeerDoc -> FilePath
$cshow :: CiteSeerDoc -> FilePath
showsPrec :: Int -> CiteSeerDoc -> ShowS
$cshowsPrec :: Int -> CiteSeerDoc -> ShowS
Show, (forall x. CiteSeerDoc -> Rep CiteSeerDoc x)
-> (forall x. Rep CiteSeerDoc x -> CiteSeerDoc)
-> Generic CiteSeerDoc
forall x. Rep CiteSeerDoc x -> CiteSeerDoc
forall x. CiteSeerDoc -> Rep CiteSeerDoc x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CiteSeerDoc x -> CiteSeerDoc
$cfrom :: forall x. CiteSeerDoc -> Rep CiteSeerDoc x
Generic, Get CiteSeerDoc
[CiteSeerDoc] -> Put
CiteSeerDoc -> Put
(CiteSeerDoc -> Put)
-> Get CiteSeerDoc -> ([CiteSeerDoc] -> Put) -> Binary CiteSeerDoc
forall t. (t -> Put) -> Get t -> ([t] -> Put) -> Binary t
putList :: [CiteSeerDoc] -> Put
$cputList :: [CiteSeerDoc] -> Put
get :: Get CiteSeerDoc
$cget :: Get CiteSeerDoc
put :: CiteSeerDoc -> Put
$cput :: CiteSeerDoc -> Put
Binary)

docClassP :: Parser CiteSeerDoc
docClassP :: Parser CiteSeerDoc
docClassP =
  (Text -> Parser Text
symbol Text
"Agents" Parser Text -> CiteSeerDoc -> Parser CiteSeerDoc
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> CiteSeerDoc
Agents) Parser CiteSeerDoc -> Parser CiteSeerDoc -> Parser CiteSeerDoc
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
  (Text -> Parser Text
symbol Text
"AI" Parser Text -> CiteSeerDoc -> Parser CiteSeerDoc
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> CiteSeerDoc
AI) Parser CiteSeerDoc -> Parser CiteSeerDoc -> Parser CiteSeerDoc
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
  (Text -> Parser Text
symbol Text
"DB" Parser Text -> CiteSeerDoc -> Parser CiteSeerDoc
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> CiteSeerDoc
DB) Parser CiteSeerDoc -> Parser CiteSeerDoc -> Parser CiteSeerDoc
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
  (Text -> Parser Text
symbol Text
"IR" Parser Text -> CiteSeerDoc -> Parser CiteSeerDoc
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> CiteSeerDoc
IR) Parser CiteSeerDoc -> Parser CiteSeerDoc -> Parser CiteSeerDoc
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
  (Text -> Parser Text
symbol Text
"ML" Parser Text -> CiteSeerDoc -> Parser CiteSeerDoc
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> CiteSeerDoc
ML) Parser CiteSeerDoc -> Parser CiteSeerDoc -> Parser CiteSeerDoc
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
  (Text -> Parser Text
symbol Text
"HCI" Parser Text -> CiteSeerDoc -> Parser CiteSeerDoc
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> CiteSeerDoc
HCI)


{-
The .cites file contains the citation graph of the corpus. Each line describes a link in the following format:

		<ID of cited paper> <ID of citing paper>

Each line contains two paper IDs. The first entry is the ID of the paper being cited and the second ID stands for the paper which contains the citation. The direction of the link is from right to left. If a line is represented by "paper1 paper2" then the link is "paper2->paper1". 
-}
-- | only process the .cites file within the archive






-- test

-- -- | one row of the .content file
-- --
-- -- λ> content0
-- -- CRow {crId = "100157", crFeatures = fromList [36,46,65,215,261,565,1162,1508,1613,1641,1662,1797,1842,1988,2025,2399,2456,2521,2597,2618,2641,2902,3016,3050,3163,3268,3272,3287,3411,3447,3669], crClass = Agents}
-- content0 = do
--   t <- T.readFile "src/Algebra/Graph/IO/Datasets/LINQS/c0"
--   parseTest contentRowP t