Core.hs 2.07 KB
Newer Older
1 2
{-|
Module      : Gargantext.Core
3
Description : Supported Natural language
4 5 6 7 8 9 10 11
Copyright   : (c) CNRS, 2017-Present
License     : AGPL + CECILL v3
Maintainer  : team@gargantext.org
Stability   : experimental
Portability : POSIX

-}

12 13
{-# LANGUAGE DeriveAnyClass             #-}

14 15 16
module Gargantext.Core
  where

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)
23 24
import GHC.Generics (Generic)
import Gargantext.Prelude
25
import Servant.API
Alexandre Delanoë's avatar
Alexandre Delanoë committed
26

27 28 29
------------------------------------------------------------------------
-- | Language of a Text
-- For simplicity, we suppose text has an homogenous language
Alexandre Delanoë's avatar
Alexandre Delanoë committed
30 31 32 33 34 35 36 37 38
-- 
-- Next steps: | DE | IT | SP
--
--  - EN == english
--  - FR == french
--  - DE == deutch  (not implemented yet)
--  - IT == italian (not implemented yet)
--  - SP == spanish (not implemented yet)
--
39
--  ... add your language and help us to implement it (:
40 41 42

-- | All languages supported
-- TODO : DE | SP | CH
43
data Lang = EN | FR | All
44
  deriving (Show, Eq, Ord, Bounded, Enum, Generic, GQLType)
45

46 47 48
instance ToJSON Lang
instance FromJSON Lang
instance ToSchema Lang
49 50
instance FromHttpApiData Lang
  where
Alexandre Delanoë's avatar
Alexandre Delanoë committed
51 52
    parseUrlPiece "EN"  = pure EN
    parseUrlPiece "FR"  = pure FR
53
    parseUrlPiece "All" = pure All
Alexandre Delanoë's avatar
Alexandre Delanoë committed
54
    parseUrlPiece _     = Left "Unexpected value of OrderBy"
55 56
instance Hashable Lang

57 58
allLangs :: [Lang]
allLangs = [minBound ..]
Alexandre Delanoë's avatar
Alexandre Delanoë committed
59 60

class HasDBid a where
61
  toDBid   :: a   -> Int
Alexandre Delanoë's avatar
Alexandre Delanoë committed
62 63 64
  fromDBid :: Int -> a

instance HasDBid Lang where
65 66 67
  toDBid All = 0
  toDBid FR  = 1
  toDBid EN  = 2
Alexandre Delanoë's avatar
Alexandre Delanoë committed
68 69 70 71 72 73

  fromDBid 0 = All
  fromDBid 1 = FR
  fromDBid 2 = EN
  fromDBid _ = panic "HasDBid lang, not implemented"

74 75 76
------------------------------------------------------------------------
type Form = Text
type Lem  = Text
Alexandre Delanoë's avatar
Alexandre Delanoë committed
77
------------------------------------------------------------------------
78
data PosTagAlgo = CoreNLP
79 80
  deriving (Show, Read, Eq, Ord, Generic)

81
instance Hashable PosTagAlgo
Alexandre Delanoë's avatar
Alexandre Delanoë committed
82

83
instance HasDBid PosTagAlgo where
84
  toDBid CoreNLP = 1
Alexandre Delanoë's avatar
Alexandre Delanoë committed
85 86 87
  fromDBid 1 = CoreNLP
  fromDBid _ = panic "HasDBid posTagAlgo : Not implemented"