src/Gargantext/Core/Text/Corpus/Parsers/FrameWrite.hs

   1 {-|
   2 Module      : Gargantext.Core.Text.Corpus.Parsers.FrameWrite
   3 Description :
   4 Copyright   : (c) CNRS, 2017-Present
   5 License     : AGPL + CECILL v3
   6 Maintainer  : team@gargantext.org
   7 Stability   : experimental
   8 Portability : POSIX
   9
  10 -}
  11
  12 module Gargantext.Core.Text.Corpus.Parsers.FrameWrite
  13   where
  14
  15 import Control.Applicative ((*>))
  16 import Control.Monad (void)
  17 import Data.Either
  18 import Data.Maybe
  19 import Data.Text hiding (foldl)
  20 import Gargantext.Core.Text (sentences)
  21 import Gargantext.Prelude
  22 import Prelude ((++), read)
  23 import Text.Parsec hiding (Line)
  24 import Text.Parsec.String
  25 import qualified Data.Text as DT
  26 import qualified Data.List as List
  27
  28
  29 -- https://gitlab.iscpif.fr/gargantext/purescript-gargantext/issues/331
  30
  31 -- Authors : default : anonymous ; except if the following line is encountered
  32 -- ^authors: FirstName1, LastName1 ; FirstName2, LastName2 ; etc.
  33 -- date : default : date of last change except if the following line is encountered  ^@@date: 2021-09-10
  34 -- source: Name of the root node except if the following line is encountered ^@@source:
  35 -- By default, 1 framawrite node = 1 document.  Option for further developments: allow to give a level at generation for the split within framawrite node : :
  36 --
  37 -- par défaut: un doc == 1 NodeWrite
  38 -- ## mean each ## section will be a new document with title the subsubsection title. Either it features options for author, date etc. or it will inherit the document's option.
  39
  40 sample :: Text
  41 sample =
  42   unlines
  43     [ "title1"
  44 --    , "title2"
  45 --    , "=="
  46 --     , "^@@authors: FirstName1, LastName1; FirstName2, LastName2"
  47     , "date: 2021-09-10"
  48     , "source: someSource"
  49     , "document contents 1"
  50     , "document contents 2"
  51     ]
  52
  53 sampleUnordered :: Text
  54 sampleUnordered =
  55   unlines
  56     [ "title1"
  57     , "title2"
  58     , "=="
  59     , "document contents 1"
  60     , "date: 2021-09-10"
  61     , "authors: FirstName1, LastName1; FirstName2, LastName2"
  62     , "source: someSource"
  63     , "document contents 2"
  64     ]
  65
  66 -- parseSample = parse documentP "sample" (unpack sample)
  67 -- parseSampleUnordered = parse documentP "sampleUnordered" (unpack sampleUnordered)
  68 parseLinesSample :: Either ParseError Parsed
  69 parseLinesSample = parseLines sample
  70 parseLinesSampleUnordered :: Either ParseError Parsed
  71 parseLinesSampleUnordered = parseLines sampleUnordered
  72
  73 data Author =
  74     Author { firstName :: Text
  75            , lastName  :: Text }
  76     deriving (Show)
  77
  78 data Parsed =
  79   Parsed { title    :: Text
  80          , authors  :: [Author]
  81          , date     :: Maybe Date
  82          , source   :: Maybe Text
  83          , contents :: Text }
  84   deriving (Show)
  85
  86 emptyParsed :: Parsed
  87 emptyParsed =
  88   Parsed { title = ""
  89          , authors = []
  90          , date = Nothing
  91          , source = Nothing
  92          , contents = "" }
  93
  94 data Date =
  95   Date { year  :: Integer
  96        , month :: Integer
  97        , day   :: Integer }
  98   deriving (Show)
  99
 100 data Line =
 101     LAuthors [Author]
 102   | LContents Text
 103   | LDate Date
 104   | LSource Text
 105   | LTitle Text
 106   deriving (Show)
 107
 108 parseLines :: Text -> Either ParseError Parsed
 109 parseLines text = foldl f emptyParsed <$> lst
 110   where
 111     lst = parse documentLinesP "" (unpack text)
 112     f (Parsed { .. }) (LAuthors as) = Parsed { authors = as, .. }
 113     f (Parsed { .. }) (LContents c) = Parsed { contents = concat [contents, c], .. }
 114     f (Parsed { .. }) (LDate    d ) = Parsed { date = Just d, .. }
 115     f (Parsed { .. }) (LSource  s ) = Parsed { source = Just s, .. }
 116     f (Parsed { .. }) (LTitle   t ) = Parsed { title = t, .. }
 117
 118 documentLinesP :: Parser [Line]
 119 documentLinesP = do
 120   t <- titleP
 121   ls <- lineP `sepBy` newline
 122   pure $ [LTitle $ pack t] ++ ls
 123
 124 lineP :: Parser Line
 125 lineP = do
 126   choice [ try authorsLineP
 127          , try dateLineP
 128          , try sourceLineP
 129          , contentsLineP ]
 130
 131 authorsLineP :: Parser Line
 132 authorsLineP = do
 133   authors <- authorsP
 134   pure $ LAuthors authors
 135
 136 dateLineP :: Parser Line
 137 dateLineP = do
 138   date <- dateP
 139   pure $ LDate date
 140
 141 sourceLineP :: Parser Line
 142 sourceLineP = do
 143   source <- sourceP
 144   pure $ LSource $ pack source
 145
 146 contentsLineP :: Parser Line
 147 contentsLineP = do
 148   contents <- many (noneOf "\n")
 149   pure $ LContents $ pack contents
 150
 151 --------------------
 152
 153 -- documentP = do
 154 --   t <- titleP
 155 --   a <- optionMaybe authorsP
 156 --   d <- optionMaybe dateP
 157 --   s <- optionMaybe sourceP
 158 --   c <- contentsP
 159 --   pure $ Parsed { title = pack t
 160 --                 , authors = fromMaybe [] a
 161 --                 , date = pack <$> d
 162 --                 , source = pack <$> s
 163 --                 , contents = pack c }
 164
 165 titleDelimiterP :: Parser ()
 166 titleDelimiterP = do
 167   _ <- newline
 168   -- _ <- try (string "==")
 169   pure ()
 170 titleP :: Parser [Char]
 171 titleP = manyTill anyChar (try titleDelimiterP)
 172
 173 authorsPrefixP :: Parser [Char]
 174 authorsPrefixP = do
 175   _ <- string "authors:"
 176   many (char ' ')
 177 authorsP :: Parser [Author]
 178 authorsP = try authorsPrefixP *> sepBy authorP (char ';')
 179 authorP :: Parser Author
 180 authorP = do
 181   fn <- manyTill anyChar (char ',')
 182   _ <- many (char ' ')
 183   --ln <- manyTill anyChar (void (char ';') <|> tokenEnd)
 184   --ln <- manyTill anyChar (tokenEnd)
 185   ln <- many (noneOf "\n")
 186   pure $ Author { firstName = pack fn, lastName = pack ln }
 187   -- manyTill anyChar (void (char '\n') <|> eof)
 188
 189 datePrefixP :: Parser [Char]
 190 datePrefixP = do
 191   _ <- string "date:"
 192   many (char ' ')
 193 dateP :: Parser Date
 194 dateP = try datePrefixP
 195          *> dateISOP
 196         --  *> many (noneOf "\n")
 197
 198 dateISOP :: Parser Date
 199 dateISOP = do
 200   year <- rd <$> number
 201   _ <- char '-'
 202   month <- rd <$> number
 203   _ <- char '-'
 204   day <- rd <$> number
 205   _ <- many (noneOf "\n" )
 206   pure $ Date { year, month, day }
 207   where
 208     rd = read :: [Char] -> Integer
 209     number = many1 digit
 210
 211 sourcePrefixP :: Parser [Char]
 212 sourcePrefixP = do
 213   _ <- string "source:"
 214   many (char ' ')
 215 sourceP :: Parser [Char]
 216 sourceP = try sourcePrefixP
 217           *> many (noneOf "\n")
 218
 219 -- contentsP :: Parser String
 220 -- contentsP = many anyChar
 221
 222 tokenEnd :: Parser ()
 223 tokenEnd = void (char '\n') <|> eof
 224
 225 --- MISC Tools
 226
 227 text2paragraphs :: Int -> Text -> [Text]
 228 text2paragraphs n = List.map DT.concat
 229                   . splitEvery n . List.map clean
 230                   . sentences . DT.concat . DT.lines
 231
 232 clean :: Text -> Text
 233 clean = DT.unwords . List.filter (\w -> DT.length w < 25) . DT.words
 234
 235