]> Git — Sourcephile - gargantext.git/blob - src/Gargantext/Core.hs
Merge remote-tracking branch 'origin/adinapoli/issue-188' into dev
[gargantext.git] / src / Gargantext / Core.hs
1 {-|
2 Module : Gargantext.Core
3 Description : Supported Natural language
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 {-# LANGUAGE DeriveAnyClass #-}
13
14 module Gargantext.Core
15 where
16
17 import Data.Aeson
18 import Data.Either(Either(Left))
19 import Data.Hashable (Hashable)
20 import Data.Morpheus.Types (GQLType)
21 import Data.Swagger
22 import Data.Text (Text, pack)
23 import Data.Tuple.Extra (swap)
24 import GHC.Generics (Generic)
25 import Gargantext.Prelude
26 import Servant.API
27 import qualified Data.Map as Map
28
29 ------------------------------------------------------------------------
30 -- | Language of a Text
31 -- For simplicity, we suppose text has an homogenous language
32 --
33 -- - EN == english
34 -- - FR == french
35 -- - DE == deutch
36 -- - IT == italian
37 -- - ES == spanish
38 -- - PL == polish
39 -- - ZH == chinese
40 --
41 -- ... add your language and help us to implement it (:
42
43 -- | All languages supported
44 -- NOTE: Use international country codes
45 -- https://en.wikipedia.org/wiki/List_of_ISO_3166_country_codes
46 data Lang = All
47 | DE
48 | EL
49 | EN
50 | ES
51 | FR
52 | IT
53 | PL
54 | PT
55 | RU
56 | UK
57 | ZH
58 deriving (Show, Eq, Ord, Enum, Bounded, Generic, GQLType)
59
60 instance ToJSON Lang
61 instance FromJSON Lang
62 instance ToSchema Lang where
63 declareNamedSchema = genericDeclareNamedSchemaUnrestricted defaultSchemaOptions
64 instance FromHttpApiData Lang
65 where
66 parseUrlPiece "All" = pure All
67 parseUrlPiece "DE" = pure DE
68 parseUrlPiece "EL" = pure EL
69 parseUrlPiece "EN" = pure EN
70 parseUrlPiece "ES" = pure ES
71 parseUrlPiece "FR" = pure FR
72 parseUrlPiece "IT" = pure IT
73 parseUrlPiece "PL" = pure PL
74 parseUrlPiece "PT" = pure PT
75 parseUrlPiece "RU" = pure RU
76 parseUrlPiece "UK" = pure UK
77 parseUrlPiece "ZH" = pure ZH
78 parseUrlPiece _ = Left "Unexpected value of Lang"
79 instance ToHttpApiData Lang where
80 toUrlPiece = pack . show
81 instance Hashable Lang
82
83 allLangs :: [Lang]
84 allLangs = [minBound ..]
85
86 class HasDBid a where
87 toDBid :: a -> Int
88 fromDBid :: Int -> a
89
90 -- NOTE: We try to use numeric codes for countries
91 -- https://en.wikipedia.org/wiki/List_of_ISO_3166_country_codes
92 -- https://en.wikipedia.org/wiki/ISO_3166-1_numeric#004
93 dbIds :: [(Lang, Int)]
94 dbIds = [ (All, 0 )
95 , (DE , 276)
96 , (EL , 300)
97 , (EN , 2 )
98 , (ES , 724)
99 , (FR , 1 )
100 , (IT , 380)
101 , (PL , 616)
102 , (PT , 620)
103 , (RU , 643)
104 , (UK , 804)
105 , (ZH , 156)
106 ]
107
108 instance HasDBid Lang where
109 toDBid lang = case Map.lookup lang $ Map.fromList dbIds of
110 Just la -> la
111 Nothing -> panic "[G.Core] Add this lang to DB ids"
112
113 fromDBid dbId = case Map.lookup dbId $ Map.fromList $ map swap dbIds of
114 Just la -> la
115 Nothing -> panic "HasDBid lang, not implemented"
116
117 ------------------------------------------------------------------------
118 data NLPServerConfig = NLPServerConfig
119 { server :: !PosTagAlgo
120 , url :: !URI }
121 deriving (Show, Eq, Generic)
122 ------------------------------------------------------------------------
123 type Form = Text
124 type Lem = Text
125 ------------------------------------------------------------------------
126 data PosTagAlgo = CoreNLP | JohnSnowServer | Spacy
127 deriving (Show, Read, Eq, Ord, Generic, GQLType)
128
129 instance Hashable PosTagAlgo
130
131 instance HasDBid PosTagAlgo where
132 toDBid CoreNLP = 1
133 toDBid JohnSnowServer = 2
134 toDBid Spacy = 3
135 fromDBid 1 = CoreNLP
136 fromDBid 2 = JohnSnowServer
137 fromDBid 3 = Spacy
138 fromDBid _ = panic "HasDBid posTagAlgo : Not implemented"