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
  31 zipFiles :: FilePath -> IO [ByteString]
  32 zipFiles fp = do
  33     path    <- resolveFile' fp
  34     entries <- withArchive path (DM.keys <$> getEntries)
  35     bs      <- mapConcurrently (\s -> withArchive path (getEntry s)) entries
  36     pure bs
  37
  38
  39 parseFile :: ParserType -> ByteString -> IO Int
  40 parseFile p x = case runParser p x of
  41         Left  _ -> pure 0
  42         Right r -> pure $ length r
  43
  44 testWos :: FilePath -> IO [Int]
  45 testWos fp = join $ mapConcurrently (parseFile WOS) <$> zipFiles fp
  46
  47 -- type Parser a = a -> Text -> [Document]
  48 data ParserType = WOS | CSV
  49
  50 wosParser :: Parser [Maybe [ByteString]]
  51 wosParser = do
  52     -- TODO Warning if version /= 1.0
  53     -- FIXME anyChar (string ..) /= exact string "\nVR 1.0" ?
  54     _ <- manyTill anyChar (string $ pack "\nVR 1.0")
  55     ns <- many1 wosNotice <* (string $ pack "\nEF")
  56     return ns
  57
  58 startNotice :: Parser ByteString
  59 startNotice = "\nPT " *> takeTill isEndOfLine
  60
  61 wosNotice :: Parser (Maybe [ByteString])
  62 wosNotice = do
  63     n <- startNotice *> wosFields <* manyTill anyChar (string $ pack "\nER\n")
  64     return n
  65
  66 field' :: Parser (ByteString, [ByteString])
  67 field' = do
  68     f  <- "\n" *> take 2 <* " "
  69     a  <- takeTill isEndOfLine
  70     as <- try wosLines
  71     let as' = case DL.length as > 0 of
  72             True  -> as
  73             False -> []
  74     return (f, [a] ++ as')
  75
  76 wosFields' :: Parser [(ByteString, [ByteString])]
  77 wosFields' = many field'
  78
  79 wosFields :: Parser (Maybe [ByteString])
  80 wosFields = do
  81 --    a <- field "AU"
  82 --    t <- field "TI"
  83 --    s <- field "SO"
  84 --    d <- field "DI" -- DOI
  85 --    p <- field "PD"
  86 --    b <- field "AB"
  87 --    u <- field "UT"
  88     ws <- many field'
  89     return $ DL.lookup "UT" ws
  90 --    return $ HyperdataDocument
  91 --                    Just "WOS"
  92 --                    DL.lookup "DI" ws
  93 --                    DL.lookup "URL" ws
  94 --                    DL.lookup "PA" ws
  95 --                    DL.lookup "TI" ws
  96 --
  97
  98 wosLines :: Parser [ByteString]
  99 wosLines = many line
 100     where
 101         line :: Parser ByteString
 102         line = "\n  " *> takeTill isEndOfLine
 103
 104 runParser :: ParserType -> ByteString -> Either String [Maybe [ByteString]]
 105 runParser p x = parseOnly parser x
 106     where
 107         parser = case p of
 108                   WOS -> wosParser
 109                   _   -> error "Not implemented yet"
 110
 111 -- isTokenChar :: Word8 -> Bool
 112 -- isTokenChar = inClass "!#$%&'()*+./0-9:<=>?@a-zA-Z[]^_`{|}~-\n"
 113