src/Gargantext/Core/Text/List/CSV.hs

   1 {-|
   2 Module      : Gargantext.Core.Text.List.CSV
   3 Description :
   4 Copyright   : (c) CNRS, 2018-Present
   5 License     : AGPL + CECILL v3
   6 Maintainer  : team@gargantext.org
   7 Stability   : experimental
   8 Portability : POSIX
   9
  10 CSV parser for Gargantext corpus files.
  11
  12 -}
  13
  14
  15 module Gargantext.Core.Text.List.CSV where
  16
  17 import GHC.IO (FilePath)
  18
  19 import Control.Applicative
  20 import Control.Monad (mzero)
  21
  22 import Data.Char (ord)
  23 import Data.Csv
  24 import Data.Either (Either(Left, Right))
  25 import Data.List (null)
  26 import Data.Text (Text, pack)
  27 import qualified Data.Text as DT
  28 import qualified Data.ByteString.Lazy as BL
  29
  30 import Data.Vector (Vector)
  31 import qualified Data.Vector as V
  32
  33 import Gargantext.Prelude hiding (length)
  34 import Gargantext.Core.Text.Context
  35
  36 ------------------------------------------------------------------------
  37
  38 csvMapTermList :: FilePath -> IO TermList
  39 csvMapTermList fp = csv2list CsvMap <$> snd <$>  fromCsvListFile fp
  40
  41 csv2list :: CsvListType -> Vector CsvList -> TermList
  42 csv2list lt vs = V.toList $ V.map (\(CsvList _ label forms)
  43                            -> (DT.words label, [DT.words label] <> (filter (not . null) . map DT.words $ DT.splitOn csvListFormsDelimiter forms)))
  44                          $ V.filter (\l -> csvList_status l == lt ) vs
  45
  46 ------------------------------------------------------------------------
  47 data CsvListType = CsvMap | CsvStop | CsvCandidate
  48   deriving (Read, Show, Eq)
  49 ------------------------------------------------------------------------
  50 -- CSV List Main Configuration
  51 csvListFieldDelimiter :: Char
  52 csvListFieldDelimiter = '\t'
  53
  54 csvListFormsDelimiter :: Text
  55 csvListFormsDelimiter = "|&|"
  56 ------------------------------------------------------------------------
  57 data CsvList = CsvList
  58     { csvList_status :: !CsvListType
  59     , csvList_label  :: !Text
  60     , csvList_forms  :: !Text
  61     }
  62     deriving (Show)
  63 ------------------------------------------------------------------------
  64 instance FromNamedRecord CsvList where
  65   parseNamedRecord r = CsvList <$> r .: "status"
  66                                <*> r .: "label"
  67                                <*> r .: "forms"
  68
  69 instance ToNamedRecord CsvList where
  70   toNamedRecord (CsvList s l f) =
  71     namedRecord [ "status" .= s
  72                 , "label"  .= l
  73                 , "forms"  .= f
  74                 ]
  75 ------------------------------------------------------------------------
  76 instance FromField CsvListType where
  77     parseField "map"  = pure CsvMap
  78     parseField "main" = pure CsvCandidate
  79     parseField "stop" = pure CsvStop
  80     parseField _      = mzero
  81
  82 instance ToField CsvListType where
  83     toField CsvMap       = "map"
  84     toField CsvCandidate = "main"
  85     toField CsvStop      = "stop"
  86 ------------------------------------------------------------------------
  87 csvDecodeOptions :: DecodeOptions
  88 csvDecodeOptions = (defaultDecodeOptions
  89                       {decDelimiter = fromIntegral $ ord csvListFieldDelimiter}
  90                     )
  91
  92 csvEncodeOptions :: EncodeOptions
  93 csvEncodeOptions = ( defaultEncodeOptions
  94                       {encDelimiter = fromIntegral $ ord csvListFieldDelimiter}
  95                     )
  96 ------------------------------------------------------------------------
  97 fromCsvListFile :: FilePath -> IO (Header, Vector CsvList)
  98 fromCsvListFile fp = do
  99     csvData <- BL.readFile fp
 100     case decodeByNameWith csvDecodeOptions csvData of
 101       Left e        -> panic (pack e)
 102       Right csvList -> pure csvList
 103 ------------------------------------------------------------------------
 104 toCsvListFile :: FilePath -> (Header, Vector CsvList) -> IO ()
 105 toCsvListFile fp (h, vs) = BL.writeFile fp $
 106                       encodeByNameWith csvEncodeOptions h (V.toList vs)
 107 ------------------------------------------------------------------------