1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
{-|
Module : Gargantext.Core.NLP
Description : GarganText NLP
Copyright : (c) CNRS, 2017-Present
License : AGPL + CECILL v3
Maintainer : team@gargantext.org
Stability : experimental
Portability : POSIX
-}
module Gargantext.Core.NLP where
import Control.Lens (Getter, at, non)
import Data.Map.Strict qualified as Map
import Data.Maybe (fromJust)
import Gargantext.Core (Lang(..), NLPServerConfig(..), PosTagAlgo(..), allLangs)
import Gargantext.Core.Config.NLP (NLPConfig(..))
import Gargantext.Utils.Tuple (uncurryMaybeSecond)
import Network.URI (URI(..), parseURI)
import Protolude hiding (All)
type NLPServerMap = Map.Map Lang NLPServerConfig
class HasNLPServer env where
nlpServer :: Getter env NLPServerMap
nlpServerGet :: Lang -> Getter env NLPServerConfig
-- default implementation
nlpServerGet l = nlpServer . at l . non defaultNLPServer
defaultNLPServer :: NLPServerConfig
defaultNLPServer = NLPServerConfig { server = CoreNLP
, url = fromJust $ parseURI "http://localhost:9000"
}
nlpServerConfigFromURI :: URI -> Maybe NLPServerConfig
nlpServerConfigFromURI uri@(URI { uriScheme = "corenlp:" }) =
Just $ NLPServerConfig { server = CoreNLP
, url = uri { uriScheme = "http:" }
}
nlpServerConfigFromURI uri@(URI { uriScheme = "corenlps:" }) =
Just $ NLPServerConfig { server = CoreNLP
, url = uri { uriScheme = "https:" }
}
nlpServerConfigFromURI uri@(URI { uriScheme = "johnsnow:" }) =
Just $ NLPServerConfig { server = JohnSnowServer
, url = uri { uriScheme = "http:" }
}
nlpServerConfigFromURI uri@(URI { uriScheme = "johnsnows:" }) =
Just $ NLPServerConfig { server = JohnSnowServer
, url = uri { uriScheme = "https:" }
}
nlpServerConfigFromURI uri@(URI { uriScheme = "spacy:" }) =
Just $ NLPServerConfig { server = Spacy
, url = uri { uriScheme = "http:" }
}
nlpServerConfigFromURI uri@(URI { uriScheme = "spacys:" }) =
Just $ NLPServerConfig { server = Spacy
, url = uri { uriScheme = "https:" }
}
nlpServerConfigFromURI _ = Nothing
nlpServerMap :: NLPConfig -> NLPServerMap
nlpServerMap (NLPConfig { .. }) =
Map.fromList $ catMaybes $
[ uncurryMaybeSecond (EN, nlpServerConfigFromURI _nlp_default) ] ++
((\lang ->
uncurryMaybeSecond (lang, Map.lookup (show lang) _nlp_languages >>= nlpServerConfigFromURI ))
<$> allLangs)