]> Git — Sourcephile - gargantext.git/blob - src/Gargantext/Text/List/CSV.hs
[FIX MERGE]
[gargantext.git] / src / Gargantext / Text / List / CSV.hs
1 {-|
2 Module : Gargantext.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.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.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 ------------------------------------------------------------------------