{-# options_ghc -Wno-unused-imports -Wno-type-defaults #-}
module Algebra.Graph.IO.Datasets where

import Algebra.Graph (Graph)
import Algebra.Graph.IO.GML (GMLGraph, gmlGraph, gmlGraphP)
import qualified Algebra.Graph.IO.SV as SV (tsvSink)
import Algebra.Graph.IO.Internal.Megaparsec (Parser, anyString)

-- 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, mapWhile)
-- megaparsec
import Text.Megaparsec (parse)
import Text.Megaparsec.Error (errorBundlePretty)
import Text.Megaparsec.Char.Lexer (decimal)

import Data.Text.IO (readFile)

import Prelude hiding (readFile)

-- | "Les Miserables" dataset
--
-- from https://github.com/gephi/gephi/wiki/Datasets
lesMiserables :: IO (Graph Int)
lesMiserables :: IO (Graph Int)
lesMiserables = do
  Text
t <- FilePath -> IO Text
readFile FilePath
"assets/lesmiserables.gml"
  case forall e s a.
Parsec e s a -> FilePath -> s -> Either (ParseErrorBundle s e) a
parse (forall a b. Parser a -> Parser b -> Parser (GMLGraph a b)
gmlGraphP forall e s (m :: * -> *) a.
(MonadParsec e s m, Token s ~ Char, Num a) =>
m a
decimal forall e s (m :: * -> *) a.
(MonadParsec e s m, Token s ~ Char, Num a) =>
m a
decimal) FilePath
"" Text
t of
    Right GMLGraph Int Integer
gg -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a b. GMLGraph a b -> Graph a
gmlGraph GMLGraph Int Integer
gg
    Left ParseErrorBundle Text Void
e -> forall a. HasCallStack => FilePath -> a
error forall a b. (a -> b) -> a -> b
$ forall s e.
(VisualStream s, TraversableStream s, ShowErrorComponent e) =>
ParseErrorBundle s e -> FilePath
errorBundlePretty ParseErrorBundle Text Void
e

-- | "Karate club" dataset
--
-- from https://github.com/gephi/gephi/wiki/Datasets
karateClub :: IO (Graph Int)
karateClub :: IO (Graph Int)
karateClub = do
  Text
t <- FilePath -> IO Text
readFile FilePath
"assets/karate.gml"
  case forall e s a.
Parsec e s a -> FilePath -> s -> Either (ParseErrorBundle s e) a
parse (forall a b. Parser a -> Parser b -> Parser (GMLGraph a b)
gmlGraphP forall e s (m :: * -> *) a.
(MonadParsec e s m, Token s ~ Char, Num a) =>
m a
decimal Parser FilePath
anyString) FilePath
"" Text
t of
    Right GMLGraph Int FilePath
gg -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a b. GMLGraph a b -> Graph a
gmlGraph GMLGraph Int FilePath
gg
    Left ParseErrorBundle Text Void
e -> forall a. HasCallStack => FilePath -> a
error forall a b. (a -> b) -> a -> b
$ forall s e.
(VisualStream s, TraversableStream s, ShowErrorComponent e) =>
ParseErrorBundle s e -> FilePath
errorBundlePretty ParseErrorBundle Text Void
e

-- | Small test dataset
--
-- from https://graphchallenge.mit.edu/data-sets
blockModel50 :: IO (Graph Int)
blockModel50 :: IO (Graph Int)
blockModel50 = forall (m :: * -> *) a. MonadUnliftIO m => ResourceT m a -> m a
runResourceT forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) r. Monad m => ConduitT () Void m r -> m r
runConduit forall a b. (a -> b) -> a -> b
$
  forall (m :: * -> *) i.
MonadResource m =>
FilePath -> ConduitT i ByteString m ()
C.sourceFile FilePath
"assets/simulated_blockmodel_graph_50_nodes.tsv" forall (m :: * -> *) a b c r.
Monad m =>
ConduitM a b m () -> ConduitM b c m r -> ConduitM a c m r
.|
  forall (m :: * -> *) o.
MonadThrow m =>
ConduitT ByteString o m (Graph Int)
SV.tsvSink