diff --git a/concrete-haskell.cabal b/concrete-haskell.cabal --- a/concrete-haskell.cabal +++ b/concrete-haskell.cabal @@ -3,7 +3,7 @@ -- see: https://github.com/sol/hpack name: concrete-haskell -version: 0.1.0.13 +version: 0.1.0.14 synopsis: Library for the Concrete data format. description: Concrete is a Thrift-based data specification designed for Natural Language Processing (NLP) applications. This library provides a Haskell interface to code generated from the latest release of Concrete. It also has a number of utilities for converting various formats (JSON, CSV, XML, etc) to Concrete Communication objects. category: Data @@ -104,10 +104,6 @@ , zip ==0.1.11 , zlib ==0.6.1.2 , concrete-haskell - other-modules: - IngestCommunications - InspectCommunications - StoreService default-language: Haskell2010 executable ingest_communications @@ -144,10 +140,6 @@ , zip ==0.1.11 , zlib ==0.6.1.2 , concrete-haskell - other-modules: - FetchService - InspectCommunications - StoreService default-language: Haskell2010 executable inspect_communications @@ -185,10 +177,6 @@ , zip ==0.1.11 , zlib ==0.6.1.2 , concrete-haskell - other-modules: - FetchService - IngestCommunications - StoreService default-language: Haskell2010 executable store_service @@ -225,10 +213,6 @@ , zip ==0.1.11 , zlib ==0.6.1.2 , concrete-haskell - other-modules: - FetchService - IngestCommunications - InspectCommunications default-language: Haskell2010 test-suite ingesters diff --git a/src/Data/Concrete/Utils.hs b/src/Data/Concrete/Utils.hs --- a/src/Data/Concrete/Utils.hs +++ b/src/Data/Concrete/Utils.hs @@ -8,6 +8,9 @@ , commToString , incrementUUID , stringToComm + , getSectionText + , getCompressor + , getDecompressor ) where import GHC.Generics @@ -53,7 +56,7 @@ import qualified Codec.Archive.Tar.Index as Tar import Data.Time import Data.Time.Clock.POSIX -import System.FilePath (takeFileName, (), (<.>)) +import System.FilePath (takeFileName, takeExtension, (), (<.>)) import Data.Either (rights) import Control.Monad (liftM, join) import Data.Foldable (foldr) @@ -61,7 +64,25 @@ import qualified Data.Vector as V import qualified Data.Binary.Get as G import qualified Control.Monad.Extra as E - + +getCompressor :: String -> (BS.ByteString -> BS.ByteString) +getCompressor f = case takeExtension f of + ".tgz" -> GZip.compress + ".gz" -> GZip.compress + ".bz2" -> BZip.compress + ".tbz2" -> BZip.compress + _ -> id + +getDecompressor :: String -> (BS.ByteString -> BS.ByteString) +getDecompressor f = case takeExtension f of + ".tgz" -> GZip.decompress + ".gz" -> GZip.decompress + ".bz2" -> BZip.decompress + ".tbz2" -> BZip.decompress + _ -> id + + + getUUID :: IO UUID getUUID = do uuid <- (T.pack . toString) <$> nextRandom @@ -148,3 +169,10 @@ metadataSects = L.map (fromMaybe "?" . section_label) ((L.filter (\x -> section_kind x /= "content")) ss) --metadataText = T.intercalate ", " metadataSects metadataText = T.concat [(T.pack . show) (L.length metadataSects), " metadata sections"] + +getSectionText :: Communication -> T.Text -> T.Text +getSectionText c n = substr text (fromIntegral s) (fromIntegral e) + where + text = fromMaybe (error "No text field!") (communication_text c) + sec = L.filter (\x -> ((fromJust . section_label) x) == n) ((V.toList . fromJust . communication_sectionList) c) + TextSpan s e = (fromJust . section_textSpan) (L.head sec) diff --git a/utils/IngestCommunications.hs b/utils/IngestCommunications.hs --- a/utils/IngestCommunications.hs +++ b/utils/IngestCommunications.hs @@ -7,12 +7,14 @@ module Main (main) where + import qualified Network as Net import Data.ByteString.Lazy (ByteString) import qualified Data.ByteString.Lazy as BS -import Data.Map (Map, toList, (!), keys) -import qualified Data.Map as Map +import Data.Map.Strict (Map, toList, (!), keys) +import qualified Data.Map.Strict as Map import Data.Monoid ((<>)) +import Data.Maybe (fromMaybe) import Data.List (intercalate) import Control.Monad (void, join, liftM) import Data.Text.Lazy (Text, unpack, take) @@ -20,7 +22,7 @@ import System.IO (stdin, stdout, stderr, openFile, Handle, IOMode(..), hPutStrLn, hClose) import System.FilePath (takeExtension) import qualified Codec.Compression.GZip as GZip -import Data.Concrete.Utils (writeCommunication) +import Data.Concrete.Utils (writeCommunication, getCompressor, getDecompressor) import Data.Concrete.Services (connectToService) import Data.Concrete.Autogen.Communication_Types (default_Communication, Communication(..)) import qualified Data.Concrete.Utils as CU @@ -45,12 +47,15 @@ main = do ps <- unwrapRecord "Ingest Concrete Communications from various formats" + let compress = getCompressor ((fromMaybe "" . inputFile) ps) + decompress = getDecompressor ((fromMaybe "" . outputFile) ps) ih <- case inputFile ps of - Just f -> case takeExtension f of - ".gz" -> (liftM GZip.decompress . BS.readFile) f - _ -> BS.readFile f - Nothing -> BS.hGetContents stdin + Just f -> (liftM decompress . BS.readFile) f +-- _ -> + -- _ -> BS.readFile f + Nothing -> (liftM decompress . BS.hGetContents) stdin let (_, cp, _, _) = (Map.fromList communicationParsers) ! (format ps) + cb <- case (outputFile ps, host ps, port ps) of (Just f, Nothing, Nothing) -> case takeExtension f of ".gz" -> writeCommunication <$> openFile f WriteMode @@ -58,7 +63,14 @@ _ -> writeCommunication <$> openFile f WriteMode (Nothing, Just h, Just p) -> do con <- connectToService h p - return $ StoreService.store con + return $ (\c -> do + --let p = CU.getSectionText c "parent_id" + -- i = CU.getSectionText c "id" + -- u = CU.getSectionText c "created_utc" + -- s = CU.getSectionText c "subreddit" + --print p + StoreService.store con c + ) (Nothing, Nothing, Nothing) -> return $ writeCommunication stdout - _ -> error "Specify either an output file, a host and port, or nothing (for stdout)" + _ -> error "Specify either an output file, a host and port, or nothing (for stdout)" ingest cb cp (decodeUtf8 ih) (contentSectionTypes ps) (commId ps) (commType ps)