src/Data/Gargantext/Parsers/WOS.hs

   1 {-# LANGUAGE OverloadedStrings #-}
   2
   3 module Data.Gargantext.Parsers.WOS where
   4
   5 import Prelude hiding (takeWhile, take, concat, readFile)
   6 import qualified Data.List as DL
   7 import Data.Map as DM
   8 import Data.Attoparsec.ByteString
   9 import Data.Attoparsec.ByteString.Char8 (anyChar, isEndOfLine)
  10 import Data.ByteString (ByteString)
  11 import Data.ByteString.Char8 (pack)
  12
  13 import Data.Either.Extra(Either(..))
  14 import Control.Applicative
  15
  16 import Control.Monad (join)
  17
  18 -- To be removed just for Tests
  19 --
  20 -- import Codec.Archive.LibZip (withArchive, fileNames, sourceFile, addFile)
  21 --import Codec.Archive.LibZip.Types (ZipSource, OpenFlag (CreateFlag))
  22
  23 import Control.Concurrent.Async as CCA (mapConcurrently)
  24
  25 import Codec.Archive.Zip
  26 import Path.IO (resolveFile')
  27 -- import qualified Data.ByteString.Lazy as B
  28 import Control.Applicative ( (<$>) )
  29
  30 -- type Parser a = a -> Text -> [Document]
  31 data ParserType = WOS | CSV
  32
  33 type WosDoc = ByteString
  34
  35
  36 wosParser :: Parser [Maybe [WosDoc]]
  37 wosParser = do
  38     -- TODO Warning if version /= 1.0
  39     -- FIXME anyChar (string ..) /= exact string "\nVR 1.0" ?
  40     _ <- manyTill anyChar (string $ pack "\nVR 1.0")
  41     ns <- many1 wosNotice <* (string $ pack "\nEF")
  42     return ns
  43
  44 wosNotice :: Parser (Maybe [WosDoc])
  45 wosNotice = startNotice *> wosFields <* endNotice
  46
  47 endNotice :: Parser [Char]
  48 endNotice = manyTill anyChar (string $ pack "\nER\n")
  49
  50 startNotice :: Parser ByteString
  51 startNotice = "\nPT " *> takeTill isEndOfLine
  52
  53 field' :: Parser (ByteString, [ByteString])
  54 field' = do
  55     f  <- "\n" *> take 2 <* " "
  56     a  <- takeTill isEndOfLine
  57     as <- try wosLines
  58     let as' = case DL.length as > 0 of
  59             True  -> as
  60             False -> []
  61     return (f, [a] ++ as')
  62
  63 wosFields' :: Parser [(ByteString, [ByteString])]
  64 wosFields' = many field'
  65
  66 wosFields :: Parser (Maybe [ByteString])
  67 wosFields = do
  68 --    a <- field "AU"
  69 --    t <- field "TI"
  70 --    s <- field "SO"
  71 --    d <- field "DI" -- DOI
  72 --    p <- field "PD"
  73 --    b <- field "AB"
  74 --    u <- field "UT"
  75     ws <- many field'
  76     return $ DL.lookup "UT" ws
  77 --    return $ HyperdataDocument
  78 --                    Just "WOS"
  79 --                    DL.lookup "DI" ws
  80 --                    DL.lookup "URL" ws
  81 --                    DL.lookup "PA" ws
  82 --                    DL.lookup "TI" ws
  83 --
  84
  85 wosLines :: Parser [ByteString]
  86 wosLines = many line
  87     where
  88         line :: Parser ByteString
  89         line = "\n  " *> takeTill isEndOfLine
  90
  91 runParser :: ParserType -> ByteString -> Either String [Maybe [WosDoc]]
  92 runParser p x = parseOnly parser x
  93     where
  94         parser = case p of
  95                   WOS -> wosParser
  96                   _   -> error "Not implemented yet"
  97
  98 -- isTokenChar :: Word8 -> Bool
  99 -- isTokenChar = inClass "!#$%&'()*+./0-9:<=>?@a-zA-Z[]^_`{|}~-\n"
 100
 101
 102 zipFiles :: FilePath -> IO [ByteString]
 103 zipFiles fp = do
 104     path    <- resolveFile' fp
 105     entries <- withArchive path (DM.keys <$> getEntries)
 106     bs      <- mapConcurrently (\s -> withArchive path (getEntry s)) entries
 107     pure bs
 108
 109
 110 parseFile :: ParserType -> ByteString -> IO Int
 111 parseFile p x = case runParser p x of
 112         Left  _ -> pure 0
 113         Right r -> pure $ length r
 114
 115 parseWos :: FilePath -> IO [Int]
 116 parseWos fp = join $ mapConcurrently (parseFile WOS) <$> zipFiles fp
 117
 118
 119