concrete-haskell-0.1.0.15: utils/InspectCommunications.hs

{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeOperators #-}

module Main (main) where

import Data.Monoid ((<>))
import qualified Data.ByteString.Lazy as BS
import qualified Codec.Compression.GZip as GZip
import qualified Codec.Compression.BZip as BZip
import qualified Data.Concrete.Utils as CU
import Data.Concrete.Autogen.Communication_Types (default_Communication, Communication(..))
import qualified Data.Concrete.Autogen.FetchCommunicationService_Client as FetchService
import Data.Concrete.Autogen.FetchCommunicationService_Iface (FetchCommunicationService_Iface(fetch, getCommunicationIDs, getCommunicationCount))
import Data.Concrete.Autogen.Access_Types (FetchRequest(..), default_FetchRequest, FetchResult(..))
import Data.Concrete.Services (connectToService)
import qualified Data.Vector as V
import Control.Monad (liftM, mapM, join)
import Data.List (intercalate, concat)
import qualified Data.Text.Lazy as T
import Data.Maybe (fromJust, catMaybes, maybeToList, fromMaybe)
import System.IO (stdin, stdout, stderr, openFile, Handle, IOMode(..), hPutStrLn)
import System.FilePath (takeExtension)
import Options.Generic
import Data.Concrete.Services.Fetch (ZipFetch(..), TarFetch(..), process, makeTarFetch, makeZipFetch, makeHandleFetch)


data Parameters w = Parameters { inputFile :: w ::: Maybe String <?> "Input file, possibly compressed (.bz2 or .gz)"
                               , start :: w ::: Maybe Int <?> "Index of first Communication to show"
                               , end :: w ::: Maybe Int <?> "Index of last Communication to show"
                               , host :: w ::: Maybe String <?> "Host name for FetchCommunicationService"
                               , port :: w ::: Maybe Int <?> "Port number for FetchCommunicationService"                               
                               }
                  deriving (Generic)


instance ParseRecord (Parameters Wrapped)
deriving instance Show (Parameters Unwrapped)


fetchDirect :: FetchCommunicationService_Iface a => a -> IO FetchResult
fetchDirect h = do
  c <- getCommunicationCount h
  cs <- getCommunicationIDs h 0 c
  fetch h $ default_FetchRequest { fetchRequest_communicationIds=cs }


main = do
  ps <- unwrapRecord "Inspect Concrete Communications"
  let s = start ps
      e = end ps
      cb = (\x -> (putStrLn . T.unpack) (CU.showCommunication x))
  FetchResult cs <- case inputFile ps of
    Nothing -> do
      con <- connectToService ((fromMaybe "0.0.0.0" . host) ps) ((fromMaybe 9090 . port) ps)
      c <- FetchService.getCommunicationCount con
      l <- FetchService.getCommunicationIDs con 0 c
      FetchService.fetch con (FetchRequest l Nothing)
    Just f -> case takeExtension f of
                ".tar" -> join $ fetchDirect <$> makeTarFetch f
                ".zip" -> join $ fetchDirect <$> makeZipFetch f
  print $ length cs
  return ()