{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE OverloadedStrings          #-}

module Database.Bloodhound.Internal.Analysis where

import           Bloodhound.Import

import qualified Data.Map.Strict as M
import qualified Data.Text as T

import           Database.Bloodhound.Internal.Newtypes
import           Database.Bloodhound.Internal.StringlyTyped

data Analysis = Analysis
  { Analysis -> Map Text AnalyzerDefinition
analysisAnalyzer :: M.Map Text AnalyzerDefinition
  , Analysis -> Map Text TokenizerDefinition
analysisTokenizer :: M.Map Text TokenizerDefinition
  , Analysis -> Map Text TokenFilterDefinition
analysisTokenFilter :: M.Map Text TokenFilterDefinition
  , Analysis -> Map Text CharFilterDefinition
analysisCharFilter :: M.Map Text CharFilterDefinition
  } deriving (Analysis -> Analysis -> Bool
(Analysis -> Analysis -> Bool)
-> (Analysis -> Analysis -> Bool) -> Eq Analysis
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Analysis -> Analysis -> Bool
$c/= :: Analysis -> Analysis -> Bool
== :: Analysis -> Analysis -> Bool
$c== :: Analysis -> Analysis -> Bool
Eq, Int -> Analysis -> ShowS
[Analysis] -> ShowS
Analysis -> String
(Int -> Analysis -> ShowS)
-> (Analysis -> String) -> ([Analysis] -> ShowS) -> Show Analysis
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Analysis] -> ShowS
$cshowList :: [Analysis] -> ShowS
show :: Analysis -> String
$cshow :: Analysis -> String
showsPrec :: Int -> Analysis -> ShowS
$cshowsPrec :: Int -> Analysis -> ShowS
Show)

instance ToJSON Analysis where
  toJSON :: Analysis -> Value
toJSON (Analysis Map Text AnalyzerDefinition
analyzer Map Text TokenizerDefinition
tokenizer Map Text TokenFilterDefinition
tokenFilter Map Text CharFilterDefinition
charFilter) = [Pair] -> Value
object
    [ Key
"analyzer" Key -> Map Text AnalyzerDefinition -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Map Text AnalyzerDefinition
analyzer
    , Key
"tokenizer" Key -> Map Text TokenizerDefinition -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Map Text TokenizerDefinition
tokenizer
    , Key
"filter" Key -> Map Text TokenFilterDefinition -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Map Text TokenFilterDefinition
tokenFilter
    , Key
"char_filter" Key -> Map Text CharFilterDefinition -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Map Text CharFilterDefinition
charFilter
    ]

instance FromJSON Analysis where
  parseJSON :: Value -> Parser Analysis
parseJSON = String -> (Object -> Parser Analysis) -> Value -> Parser Analysis
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"Analysis" ((Object -> Parser Analysis) -> Value -> Parser Analysis)
-> (Object -> Parser Analysis) -> Value -> Parser Analysis
forall a b. (a -> b) -> a -> b
$ \Object
m -> Map Text AnalyzerDefinition
-> Map Text TokenizerDefinition
-> Map Text TokenFilterDefinition
-> Map Text CharFilterDefinition
-> Analysis
Analysis
    (Map Text AnalyzerDefinition
 -> Map Text TokenizerDefinition
 -> Map Text TokenFilterDefinition
 -> Map Text CharFilterDefinition
 -> Analysis)
-> Parser (Map Text AnalyzerDefinition)
-> Parser
     (Map Text TokenizerDefinition
      -> Map Text TokenFilterDefinition
      -> Map Text CharFilterDefinition
      -> Analysis)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
m Object -> Key -> Parser (Map Text AnalyzerDefinition)
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"analyzer"
    Parser
  (Map Text TokenizerDefinition
   -> Map Text TokenFilterDefinition
   -> Map Text CharFilterDefinition
   -> Analysis)
-> Parser (Map Text TokenizerDefinition)
-> Parser
     (Map Text TokenFilterDefinition
      -> Map Text CharFilterDefinition -> Analysis)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
m Object -> Key -> Parser (Maybe (Map Text TokenizerDefinition))
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"tokenizer" Parser (Maybe (Map Text TokenizerDefinition))
-> Map Text TokenizerDefinition
-> Parser (Map Text TokenizerDefinition)
forall a. Parser (Maybe a) -> a -> Parser a
.!= Map Text TokenizerDefinition
forall k a. Map k a
M.empty
    Parser
  (Map Text TokenFilterDefinition
   -> Map Text CharFilterDefinition -> Analysis)
-> Parser (Map Text TokenFilterDefinition)
-> Parser (Map Text CharFilterDefinition -> Analysis)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
m Object -> Key -> Parser (Maybe (Map Text TokenFilterDefinition))
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"filter" Parser (Maybe (Map Text TokenFilterDefinition))
-> Map Text TokenFilterDefinition
-> Parser (Map Text TokenFilterDefinition)
forall a. Parser (Maybe a) -> a -> Parser a
.!= Map Text TokenFilterDefinition
forall k a. Map k a
M.empty
    Parser (Map Text CharFilterDefinition -> Analysis)
-> Parser (Map Text CharFilterDefinition) -> Parser Analysis
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
m Object -> Key -> Parser (Maybe (Map Text CharFilterDefinition))
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"char_filter" Parser (Maybe (Map Text CharFilterDefinition))
-> Map Text CharFilterDefinition
-> Parser (Map Text CharFilterDefinition)
forall a. Parser (Maybe a) -> a -> Parser a
.!= Map Text CharFilterDefinition
forall k a. Map k a
M.empty

newtype Tokenizer =
  Tokenizer Text
  deriving (Tokenizer -> Tokenizer -> Bool
(Tokenizer -> Tokenizer -> Bool)
-> (Tokenizer -> Tokenizer -> Bool) -> Eq Tokenizer
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Tokenizer -> Tokenizer -> Bool
$c/= :: Tokenizer -> Tokenizer -> Bool
== :: Tokenizer -> Tokenizer -> Bool
$c== :: Tokenizer -> Tokenizer -> Bool
Eq, Int -> Tokenizer -> ShowS
[Tokenizer] -> ShowS
Tokenizer -> String
(Int -> Tokenizer -> ShowS)
-> (Tokenizer -> String)
-> ([Tokenizer] -> ShowS)
-> Show Tokenizer
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Tokenizer] -> ShowS
$cshowList :: [Tokenizer] -> ShowS
show :: Tokenizer -> String
$cshow :: Tokenizer -> String
showsPrec :: Int -> Tokenizer -> ShowS
$cshowsPrec :: Int -> Tokenizer -> ShowS
Show, [Tokenizer] -> Encoding
[Tokenizer] -> Value
Tokenizer -> Encoding
Tokenizer -> Value
(Tokenizer -> Value)
-> (Tokenizer -> Encoding)
-> ([Tokenizer] -> Value)
-> ([Tokenizer] -> Encoding)
-> ToJSON Tokenizer
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [Tokenizer] -> Encoding
$ctoEncodingList :: [Tokenizer] -> Encoding
toJSONList :: [Tokenizer] -> Value
$ctoJSONList :: [Tokenizer] -> Value
toEncoding :: Tokenizer -> Encoding
$ctoEncoding :: Tokenizer -> Encoding
toJSON :: Tokenizer -> Value
$ctoJSON :: Tokenizer -> Value
ToJSON, Value -> Parser [Tokenizer]
Value -> Parser Tokenizer
(Value -> Parser Tokenizer)
-> (Value -> Parser [Tokenizer]) -> FromJSON Tokenizer
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [Tokenizer]
$cparseJSONList :: Value -> Parser [Tokenizer]
parseJSON :: Value -> Parser Tokenizer
$cparseJSON :: Value -> Parser Tokenizer
FromJSON)

data AnalyzerDefinition = AnalyzerDefinition
  { AnalyzerDefinition -> Maybe Tokenizer
analyzerDefinitionTokenizer :: Maybe Tokenizer
  , AnalyzerDefinition -> [TokenFilter]
analyzerDefinitionFilter :: [TokenFilter]
  , AnalyzerDefinition -> [CharFilter]
analyzerDefinitionCharFilter :: [CharFilter]
  } deriving (AnalyzerDefinition -> AnalyzerDefinition -> Bool
(AnalyzerDefinition -> AnalyzerDefinition -> Bool)
-> (AnalyzerDefinition -> AnalyzerDefinition -> Bool)
-> Eq AnalyzerDefinition
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AnalyzerDefinition -> AnalyzerDefinition -> Bool
$c/= :: AnalyzerDefinition -> AnalyzerDefinition -> Bool
== :: AnalyzerDefinition -> AnalyzerDefinition -> Bool
$c== :: AnalyzerDefinition -> AnalyzerDefinition -> Bool
Eq,Int -> AnalyzerDefinition -> ShowS
[AnalyzerDefinition] -> ShowS
AnalyzerDefinition -> String
(Int -> AnalyzerDefinition -> ShowS)
-> (AnalyzerDefinition -> String)
-> ([AnalyzerDefinition] -> ShowS)
-> Show AnalyzerDefinition
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AnalyzerDefinition] -> ShowS
$cshowList :: [AnalyzerDefinition] -> ShowS
show :: AnalyzerDefinition -> String
$cshow :: AnalyzerDefinition -> String
showsPrec :: Int -> AnalyzerDefinition -> ShowS
$cshowsPrec :: Int -> AnalyzerDefinition -> ShowS
Show)

instance ToJSON AnalyzerDefinition where
  toJSON :: AnalyzerDefinition -> Value
toJSON (AnalyzerDefinition Maybe Tokenizer
tokenizer [TokenFilter]
tokenFilter [CharFilter]
charFilter) =
    [Pair] -> Value
object ([Pair] -> Value) -> [Pair] -> Value
forall a b. (a -> b) -> a -> b
$ [Maybe Pair] -> [Pair]
forall a. [Maybe a] -> [a]
catMaybes
    [ (Tokenizer -> Pair) -> Maybe Tokenizer -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Key
"tokenizer" Key -> Tokenizer -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.=) Maybe Tokenizer
tokenizer
    , Pair -> Maybe Pair
forall a. a -> Maybe a
Just (Pair -> Maybe Pair) -> Pair -> Maybe Pair
forall a b. (a -> b) -> a -> b
$ Key
"filter" Key -> [TokenFilter] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= [TokenFilter]
tokenFilter
    , Pair -> Maybe Pair
forall a. a -> Maybe a
Just (Pair -> Maybe Pair) -> Pair -> Maybe Pair
forall a b. (a -> b) -> a -> b
$ Key
"char_filter" Key -> [CharFilter] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= [CharFilter]
charFilter
    ]

instance FromJSON AnalyzerDefinition where
  parseJSON :: Value -> Parser AnalyzerDefinition
parseJSON = String
-> (Object -> Parser AnalyzerDefinition)
-> Value
-> Parser AnalyzerDefinition
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"AnalyzerDefinition" ((Object -> Parser AnalyzerDefinition)
 -> Value -> Parser AnalyzerDefinition)
-> (Object -> Parser AnalyzerDefinition)
-> Value
-> Parser AnalyzerDefinition
forall a b. (a -> b) -> a -> b
$ \Object
m -> Maybe Tokenizer
-> [TokenFilter] -> [CharFilter] -> AnalyzerDefinition
AnalyzerDefinition
    (Maybe Tokenizer
 -> [TokenFilter] -> [CharFilter] -> AnalyzerDefinition)
-> Parser (Maybe Tokenizer)
-> Parser ([TokenFilter] -> [CharFilter] -> AnalyzerDefinition)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
m Object -> Key -> Parser (Maybe Tokenizer)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"tokenizer"
    Parser ([TokenFilter] -> [CharFilter] -> AnalyzerDefinition)
-> Parser [TokenFilter]
-> Parser ([CharFilter] -> AnalyzerDefinition)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
m Object -> Key -> Parser (Maybe [TokenFilter])
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"filter" Parser (Maybe [TokenFilter])
-> [TokenFilter] -> Parser [TokenFilter]
forall a. Parser (Maybe a) -> a -> Parser a
.!= []
    Parser ([CharFilter] -> AnalyzerDefinition)
-> Parser [CharFilter] -> Parser AnalyzerDefinition
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
m Object -> Key -> Parser (Maybe [CharFilter])
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"char_filter" Parser (Maybe [CharFilter]) -> [CharFilter] -> Parser [CharFilter]
forall a. Parser (Maybe a) -> a -> Parser a
.!= []

-- | Character filters are used to preprocess the stream of characters
--   before it is passed to the tokenizer.
data CharFilterDefinition
  = CharFilterDefinitionMapping (M.Map Text Text)
  | CharFilterDefinitionPatternReplace
    { CharFilterDefinition -> Text
charFilterDefinitionPatternReplacePattern :: Text
    , CharFilterDefinition -> Text
charFilterDefinitionPatternReplaceReplacement :: Text
    , CharFilterDefinition -> Maybe Text
charFilterDefinitionPatternReplaceFlags :: Maybe Text
    }
  deriving (CharFilterDefinition -> CharFilterDefinition -> Bool
(CharFilterDefinition -> CharFilterDefinition -> Bool)
-> (CharFilterDefinition -> CharFilterDefinition -> Bool)
-> Eq CharFilterDefinition
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CharFilterDefinition -> CharFilterDefinition -> Bool
$c/= :: CharFilterDefinition -> CharFilterDefinition -> Bool
== :: CharFilterDefinition -> CharFilterDefinition -> Bool
$c== :: CharFilterDefinition -> CharFilterDefinition -> Bool
Eq, Int -> CharFilterDefinition -> ShowS
[CharFilterDefinition] -> ShowS
CharFilterDefinition -> String
(Int -> CharFilterDefinition -> ShowS)
-> (CharFilterDefinition -> String)
-> ([CharFilterDefinition] -> ShowS)
-> Show CharFilterDefinition
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CharFilterDefinition] -> ShowS
$cshowList :: [CharFilterDefinition] -> ShowS
show :: CharFilterDefinition -> String
$cshow :: CharFilterDefinition -> String
showsPrec :: Int -> CharFilterDefinition -> ShowS
$cshowsPrec :: Int -> CharFilterDefinition -> ShowS
Show)

instance ToJSON CharFilterDefinition where
  toJSON :: CharFilterDefinition -> Value
toJSON (CharFilterDefinitionMapping Map Text Text
ms) = [Pair] -> Value
object
    [ Key
"type" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= (Text
"mapping" :: Text)
    , Key
"mappings" Key -> [Text] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= [Text
a Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" => " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
b | (Text
a, Text
b) <- Map Text Text -> [(Text, Text)]
forall k a. Map k a -> [(k, a)]
M.toList Map Text Text
ms] ]
  toJSON (CharFilterDefinitionPatternReplace Text
pat Text
repl Maybe Text
flags) = [Pair] -> Value
object ([Pair] -> Value) -> [Pair] -> Value
forall a b. (a -> b) -> a -> b
$
    [ Key
"type" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= (Text
"pattern_replace" :: Text)
    , Key
"pattern" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
pat
    , Key
"replacement" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
repl
    ] [Pair] -> [Pair] -> [Pair]
forall a. [a] -> [a] -> [a]
++ [Pair] -> (Text -> [Pair]) -> Maybe Text -> [Pair]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (\Text
f -> [Key
"flags" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
f]) Maybe Text
flags

instance FromJSON CharFilterDefinition where
  parseJSON :: Value -> Parser CharFilterDefinition
parseJSON = String
-> (Object -> Parser CharFilterDefinition)
-> Value
-> Parser CharFilterDefinition
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"CharFilterDefinition" ((Object -> Parser CharFilterDefinition)
 -> Value -> Parser CharFilterDefinition)
-> (Object -> Parser CharFilterDefinition)
-> Value
-> Parser CharFilterDefinition
forall a b. (a -> b) -> a -> b
$ \Object
m -> do
    Text
t <- Object
m Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"type"
    case (Text
t :: Text) of
      Text
"mapping" -> Map Text Text -> CharFilterDefinition
CharFilterDefinitionMapping (Map Text Text -> CharFilterDefinition)
-> ([(Text, Text)] -> Map Text Text)
-> [(Text, Text)]
-> CharFilterDefinition
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Text, Text)] -> Map Text Text
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ([(Text, Text)] -> CharFilterDefinition)
-> Parser [(Text, Text)] -> Parser CharFilterDefinition
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser [(Text, Text)]
ms
        where
          ms :: Parser [(Text, Text)]
ms = Object
m Object -> Key -> Parser [Text]
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"mappings" Parser [Text]
-> ([Text] -> Parser [(Text, Text)]) -> Parser [(Text, Text)]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Text -> Parser (Text, Text)) -> [Text] -> Parser [(Text, Text)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Text -> Parser (Text, Text)
forall (f :: * -> *). MonadFail f => Text -> f (Text, Text)
parseMapping
          parseMapping :: Text -> f (Text, Text)
parseMapping Text
kv = case Text -> Text -> [Text]
T.splitOn Text
"=>" Text
kv of
            (Text
k:[Text]
vs) -> (Text, Text) -> f (Text, Text)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> Text
T.strip Text
k, Text -> Text
T.strip (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
T.concat [Text]
vs)
            [Text]
_ -> String -> f (Text, Text)
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"mapping is not of the format key => value"
      Text
"pattern_replace" -> Text -> Text -> Maybe Text -> CharFilterDefinition
CharFilterDefinitionPatternReplace
        (Text -> Text -> Maybe Text -> CharFilterDefinition)
-> Parser Text
-> Parser (Text -> Maybe Text -> CharFilterDefinition)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
m Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"pattern" Parser (Text -> Maybe Text -> CharFilterDefinition)
-> Parser Text -> Parser (Maybe Text -> CharFilterDefinition)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
m Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"replacement" Parser (Maybe Text -> CharFilterDefinition)
-> Parser (Maybe Text) -> Parser CharFilterDefinition
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
m Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"flags"
      Text
_ -> String -> Parser CharFilterDefinition
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
"unrecognized character filter type: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Text -> String
T.unpack Text
t)

newtype TokenizerDefinition =
  TokenizerDefinitionNgram Ngram
  deriving (TokenizerDefinition -> TokenizerDefinition -> Bool
(TokenizerDefinition -> TokenizerDefinition -> Bool)
-> (TokenizerDefinition -> TokenizerDefinition -> Bool)
-> Eq TokenizerDefinition
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TokenizerDefinition -> TokenizerDefinition -> Bool
$c/= :: TokenizerDefinition -> TokenizerDefinition -> Bool
== :: TokenizerDefinition -> TokenizerDefinition -> Bool
$c== :: TokenizerDefinition -> TokenizerDefinition -> Bool
Eq,Int -> TokenizerDefinition -> ShowS
[TokenizerDefinition] -> ShowS
TokenizerDefinition -> String
(Int -> TokenizerDefinition -> ShowS)
-> (TokenizerDefinition -> String)
-> ([TokenizerDefinition] -> ShowS)
-> Show TokenizerDefinition
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TokenizerDefinition] -> ShowS
$cshowList :: [TokenizerDefinition] -> ShowS
show :: TokenizerDefinition -> String
$cshow :: TokenizerDefinition -> String
showsPrec :: Int -> TokenizerDefinition -> ShowS
$cshowsPrec :: Int -> TokenizerDefinition -> ShowS
Show)

instance ToJSON TokenizerDefinition where
  toJSON :: TokenizerDefinition -> Value
toJSON TokenizerDefinition
x = case TokenizerDefinition
x of
    TokenizerDefinitionNgram (Ngram Int
minGram Int
maxGram [TokenChar]
tokenChars) -> [Pair] -> Value
object
      [ Key
"type" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= (Text
"ngram" :: Text)
      , Key
"min_gram" Key -> Int -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Int
minGram
      , Key
"max_gram" Key -> Int -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Int
maxGram
      , Key
"token_chars" Key -> [TokenChar] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= [TokenChar]
tokenChars
      ]

instance FromJSON TokenizerDefinition where
  parseJSON :: Value -> Parser TokenizerDefinition
parseJSON = String
-> (Object -> Parser TokenizerDefinition)
-> Value
-> Parser TokenizerDefinition
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"TokenizerDefinition" ((Object -> Parser TokenizerDefinition)
 -> Value -> Parser TokenizerDefinition)
-> (Object -> Parser TokenizerDefinition)
-> Value
-> Parser TokenizerDefinition
forall a b. (a -> b) -> a -> b
$ \Object
m -> do
    Text
typ <- Object
m Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"type" :: Parser Text
    case Text
typ of
      Text
"ngram" -> (Ngram -> TokenizerDefinition)
-> Parser Ngram -> Parser TokenizerDefinition
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Ngram -> TokenizerDefinition
TokenizerDefinitionNgram (Parser Ngram -> Parser TokenizerDefinition)
-> Parser Ngram -> Parser TokenizerDefinition
forall a b. (a -> b) -> a -> b
$ Int -> Int -> [TokenChar] -> Ngram
Ngram
        (Int -> Int -> [TokenChar] -> Ngram)
-> Parser Int -> Parser (Int -> [TokenChar] -> Ngram)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (StringlyTypedInt -> Int) -> Parser StringlyTypedInt -> Parser Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap StringlyTypedInt -> Int
unStringlyTypedInt (Object
m Object -> Key -> Parser StringlyTypedInt
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"min_gram")
        Parser (Int -> [TokenChar] -> Ngram)
-> Parser Int -> Parser ([TokenChar] -> Ngram)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (StringlyTypedInt -> Int) -> Parser StringlyTypedInt -> Parser Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap StringlyTypedInt -> Int
unStringlyTypedInt (Object
m Object -> Key -> Parser StringlyTypedInt
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"max_gram")
        Parser ([TokenChar] -> Ngram) -> Parser [TokenChar] -> Parser Ngram
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
m Object -> Key -> Parser [TokenChar]
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"token_chars"
      Text
_ -> String -> Parser TokenizerDefinition
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"invalid TokenizerDefinition"

data Ngram = Ngram
  { Ngram -> Int
ngramMinGram :: Int
  , Ngram -> Int
ngramMaxGram :: Int
  , Ngram -> [TokenChar]
ngramTokenChars :: [TokenChar]
  } deriving (Ngram -> Ngram -> Bool
(Ngram -> Ngram -> Bool) -> (Ngram -> Ngram -> Bool) -> Eq Ngram
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Ngram -> Ngram -> Bool
$c/= :: Ngram -> Ngram -> Bool
== :: Ngram -> Ngram -> Bool
$c== :: Ngram -> Ngram -> Bool
Eq,Int -> Ngram -> ShowS
[Ngram] -> ShowS
Ngram -> String
(Int -> Ngram -> ShowS)
-> (Ngram -> String) -> ([Ngram] -> ShowS) -> Show Ngram
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Ngram] -> ShowS
$cshowList :: [Ngram] -> ShowS
show :: Ngram -> String
$cshow :: Ngram -> String
showsPrec :: Int -> Ngram -> ShowS
$cshowsPrec :: Int -> Ngram -> ShowS
Show)

data TokenChar =
    TokenLetter
  | TokenDigit
  | TokenWhitespace
  | TokenPunctuation
  | TokenSymbol
  deriving (TokenChar -> TokenChar -> Bool
(TokenChar -> TokenChar -> Bool)
-> (TokenChar -> TokenChar -> Bool) -> Eq TokenChar
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TokenChar -> TokenChar -> Bool
$c/= :: TokenChar -> TokenChar -> Bool
== :: TokenChar -> TokenChar -> Bool
$c== :: TokenChar -> TokenChar -> Bool
Eq,Int -> TokenChar -> ShowS
[TokenChar] -> ShowS
TokenChar -> String
(Int -> TokenChar -> ShowS)
-> (TokenChar -> String)
-> ([TokenChar] -> ShowS)
-> Show TokenChar
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TokenChar] -> ShowS
$cshowList :: [TokenChar] -> ShowS
show :: TokenChar -> String
$cshow :: TokenChar -> String
showsPrec :: Int -> TokenChar -> ShowS
$cshowsPrec :: Int -> TokenChar -> ShowS
Show)

instance ToJSON TokenChar where
  toJSON :: TokenChar -> Value
toJSON TokenChar
t = Text -> Value
String (Text -> Value) -> Text -> Value
forall a b. (a -> b) -> a -> b
$ case TokenChar
t of
    TokenChar
TokenLetter -> Text
"letter"
    TokenChar
TokenDigit -> Text
"digit"
    TokenChar
TokenWhitespace -> Text
"whitespace"
    TokenChar
TokenPunctuation -> Text
"punctuation"
    TokenChar
TokenSymbol -> Text
"symbol"

instance FromJSON TokenChar where
  parseJSON :: Value -> Parser TokenChar
parseJSON = String -> (Text -> Parser TokenChar) -> Value -> Parser TokenChar
forall a. String -> (Text -> Parser a) -> Value -> Parser a
withText String
"TokenChar" ((Text -> Parser TokenChar) -> Value -> Parser TokenChar)
-> (Text -> Parser TokenChar) -> Value -> Parser TokenChar
forall a b. (a -> b) -> a -> b
$ \Text
t -> case Text
t of
    Text
"letter" -> TokenChar -> Parser TokenChar
forall (m :: * -> *) a. Monad m => a -> m a
return TokenChar
TokenLetter
    Text
"digit" -> TokenChar -> Parser TokenChar
forall (m :: * -> *) a. Monad m => a -> m a
return TokenChar
TokenDigit
    Text
"whitespace" -> TokenChar -> Parser TokenChar
forall (m :: * -> *) a. Monad m => a -> m a
return TokenChar
TokenWhitespace
    Text
"punctuation" -> TokenChar -> Parser TokenChar
forall (m :: * -> *) a. Monad m => a -> m a
return TokenChar
TokenPunctuation
    Text
"symbol" -> TokenChar -> Parser TokenChar
forall (m :: * -> *) a. Monad m => a -> m a
return TokenChar
TokenSymbol
    Text
_ -> String -> Parser TokenChar
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"invalid TokenChar"

-- | Token filters are used to create custom analyzers.
data TokenFilterDefinition
  = TokenFilterDefinitionLowercase (Maybe Language)
  | TokenFilterDefinitionUppercase (Maybe Language)
  | TokenFilterDefinitionApostrophe
  | TokenFilterDefinitionReverse
  | TokenFilterDefinitionSnowball Language
  | TokenFilterDefinitionShingle Shingle
  | TokenFilterDefinitionStemmer Language
  | TokenFilterDefinitionStop (Either Language [StopWord])
  deriving (TokenFilterDefinition -> TokenFilterDefinition -> Bool
(TokenFilterDefinition -> TokenFilterDefinition -> Bool)
-> (TokenFilterDefinition -> TokenFilterDefinition -> Bool)
-> Eq TokenFilterDefinition
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TokenFilterDefinition -> TokenFilterDefinition -> Bool
$c/= :: TokenFilterDefinition -> TokenFilterDefinition -> Bool
== :: TokenFilterDefinition -> TokenFilterDefinition -> Bool
$c== :: TokenFilterDefinition -> TokenFilterDefinition -> Bool
Eq, Int -> TokenFilterDefinition -> ShowS
[TokenFilterDefinition] -> ShowS
TokenFilterDefinition -> String
(Int -> TokenFilterDefinition -> ShowS)
-> (TokenFilterDefinition -> String)
-> ([TokenFilterDefinition] -> ShowS)
-> Show TokenFilterDefinition
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TokenFilterDefinition] -> ShowS
$cshowList :: [TokenFilterDefinition] -> ShowS
show :: TokenFilterDefinition -> String
$cshow :: TokenFilterDefinition -> String
showsPrec :: Int -> TokenFilterDefinition -> ShowS
$cshowsPrec :: Int -> TokenFilterDefinition -> ShowS
Show)

instance ToJSON TokenFilterDefinition where
  toJSON :: TokenFilterDefinition -> Value
toJSON TokenFilterDefinition
x = case TokenFilterDefinition
x of
    TokenFilterDefinitionLowercase Maybe Language
mlang -> [Pair] -> Value
object ([Pair] -> Value) -> [Pair] -> Value
forall a b. (a -> b) -> a -> b
$ [Maybe Pair] -> [Pair]
forall a. [Maybe a] -> [a]
catMaybes
      [ Pair -> Maybe Pair
forall a. a -> Maybe a
Just (Pair -> Maybe Pair) -> Pair -> Maybe Pair
forall a b. (a -> b) -> a -> b
$ Key
"type" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= (Text
"lowercase" :: Text)
      , (Language -> Pair) -> Maybe Language -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Language
lang -> Key
"language" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Language -> Text
languageToText Language
lang) Maybe Language
mlang
      ]
    TokenFilterDefinitionUppercase Maybe Language
mlang -> [Pair] -> Value
object ([Pair] -> Value) -> [Pair] -> Value
forall a b. (a -> b) -> a -> b
$ [Maybe Pair] -> [Pair]
forall a. [Maybe a] -> [a]
catMaybes
      [ Pair -> Maybe Pair
forall a. a -> Maybe a
Just (Pair -> Maybe Pair) -> Pair -> Maybe Pair
forall a b. (a -> b) -> a -> b
$ Key
"type" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= (Text
"uppercase" :: Text)
      , (Language -> Pair) -> Maybe Language -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Language
lang -> Key
"language" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Language -> Text
languageToText Language
lang) Maybe Language
mlang
      ]
    TokenFilterDefinition
TokenFilterDefinitionApostrophe -> [Pair] -> Value
object
      [ Key
"type" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= (Text
"apostrophe" :: Text)
      ]
    TokenFilterDefinition
TokenFilterDefinitionReverse -> [Pair] -> Value
object
      [ Key
"type" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= (Text
"reverse" :: Text)
      ]
    TokenFilterDefinitionSnowball Language
lang -> [Pair] -> Value
object
      [ Key
"type" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= (Text
"snowball" :: Text)
      , Key
"language" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Language -> Text
languageToText Language
lang
      ]
    TokenFilterDefinitionShingle Shingle
s -> [Pair] -> Value
object
      [ Key
"type" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= (Text
"shingle" :: Text)
      , Key
"max_shingle_size" Key -> Int -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Shingle -> Int
shingleMaxSize Shingle
s
      , Key
"min_shingle_size" Key -> Int -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Shingle -> Int
shingleMinSize Shingle
s
      , Key
"output_unigrams" Key -> Bool -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Shingle -> Bool
shingleOutputUnigrams Shingle
s
      , Key
"output_unigrams_if_no_shingles" Key -> Bool -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Shingle -> Bool
shingleOutputUnigramsIfNoShingles Shingle
s
      , Key
"token_separator" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Shingle -> Text
shingleTokenSeparator Shingle
s
      , Key
"filler_token" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Shingle -> Text
shingleFillerToken Shingle
s
      ]
    TokenFilterDefinitionStemmer Language
lang -> [Pair] -> Value
object
      [ Key
"type" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= (Text
"stemmer" :: Text)
      , Key
"language" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Language -> Text
languageToText Language
lang
      ]
    TokenFilterDefinitionStop Either Language [StopWord]
stop -> [Pair] -> Value
object
      [ Key
"type" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= (Text
"stop" :: Text)
      , Key
"stopwords" Key -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= case Either Language [StopWord]
stop of
          Left Language
lang -> Text -> Value
String (Text -> Value) -> Text -> Value
forall a b. (a -> b) -> a -> b
$ Text
"_" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Language -> Text
languageToText Language
lang Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"_"
          Right [StopWord]
stops -> [StopWord] -> Value
forall a. ToJSON a => a -> Value
toJSON [StopWord]
stops
      ]

instance FromJSON TokenFilterDefinition where
  parseJSON :: Value -> Parser TokenFilterDefinition
parseJSON = String
-> (Object -> Parser TokenFilterDefinition)
-> Value
-> Parser TokenFilterDefinition
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"TokenFilterDefinition" ((Object -> Parser TokenFilterDefinition)
 -> Value -> Parser TokenFilterDefinition)
-> (Object -> Parser TokenFilterDefinition)
-> Value
-> Parser TokenFilterDefinition
forall a b. (a -> b) -> a -> b
$ \Object
m -> do
    Text
t <- Object
m Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"type"
    case (Text
t :: Text) of
      Text
"reverse" -> TokenFilterDefinition -> Parser TokenFilterDefinition
forall (m :: * -> *) a. Monad m => a -> m a
return TokenFilterDefinition
TokenFilterDefinitionReverse
      Text
"apostrophe" -> TokenFilterDefinition -> Parser TokenFilterDefinition
forall (m :: * -> *) a. Monad m => a -> m a
return TokenFilterDefinition
TokenFilterDefinitionApostrophe
      Text
"lowercase" -> Maybe Language -> TokenFilterDefinition
TokenFilterDefinitionLowercase
        (Maybe Language -> TokenFilterDefinition)
-> Parser (Maybe Language) -> Parser TokenFilterDefinition
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
m Object -> Key -> Parser (Maybe Language)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"language"
      Text
"uppercase" -> Maybe Language -> TokenFilterDefinition
TokenFilterDefinitionUppercase
        (Maybe Language -> TokenFilterDefinition)
-> Parser (Maybe Language) -> Parser TokenFilterDefinition
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
m Object -> Key -> Parser (Maybe Language)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"language"
      Text
"snowball" -> Language -> TokenFilterDefinition
TokenFilterDefinitionSnowball
        (Language -> TokenFilterDefinition)
-> Parser Language -> Parser TokenFilterDefinition
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
m Object -> Key -> Parser Language
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"language"
      Text
"shingle" -> (Shingle -> TokenFilterDefinition)
-> Parser Shingle -> Parser TokenFilterDefinition
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Shingle -> TokenFilterDefinition
TokenFilterDefinitionShingle (Parser Shingle -> Parser TokenFilterDefinition)
-> Parser Shingle -> Parser TokenFilterDefinition
forall a b. (a -> b) -> a -> b
$ Int -> Int -> Bool -> Bool -> Text -> Text -> Shingle
Shingle
        (Int -> Int -> Bool -> Bool -> Text -> Text -> Shingle)
-> Parser Int
-> Parser (Int -> Bool -> Bool -> Text -> Text -> Shingle)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((Maybe StringlyTypedInt -> Maybe Int)
-> Parser (Maybe StringlyTypedInt) -> Parser (Maybe Int)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap((Maybe StringlyTypedInt -> Maybe Int)
 -> Parser (Maybe StringlyTypedInt) -> Parser (Maybe Int))
-> ((StringlyTypedInt -> Int)
    -> Maybe StringlyTypedInt -> Maybe Int)
-> (StringlyTypedInt -> Int)
-> Parser (Maybe StringlyTypedInt)
-> Parser (Maybe Int)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(StringlyTypedInt -> Int) -> Maybe StringlyTypedInt -> Maybe Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap) StringlyTypedInt -> Int
unStringlyTypedInt (Object
m Object -> Key -> Parser (Maybe StringlyTypedInt)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"max_shingle_size") Parser (Maybe Int) -> Int -> Parser Int
forall a. Parser (Maybe a) -> a -> Parser a
.!= Int
2
        Parser (Int -> Bool -> Bool -> Text -> Text -> Shingle)
-> Parser Int -> Parser (Bool -> Bool -> Text -> Text -> Shingle)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ((Maybe StringlyTypedInt -> Maybe Int)
-> Parser (Maybe StringlyTypedInt) -> Parser (Maybe Int)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap((Maybe StringlyTypedInt -> Maybe Int)
 -> Parser (Maybe StringlyTypedInt) -> Parser (Maybe Int))
-> ((StringlyTypedInt -> Int)
    -> Maybe StringlyTypedInt -> Maybe Int)
-> (StringlyTypedInt -> Int)
-> Parser (Maybe StringlyTypedInt)
-> Parser (Maybe Int)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(StringlyTypedInt -> Int) -> Maybe StringlyTypedInt -> Maybe Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap) StringlyTypedInt -> Int
unStringlyTypedInt (Object
m Object -> Key -> Parser (Maybe StringlyTypedInt)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"min_shingle_size") Parser (Maybe Int) -> Int -> Parser Int
forall a. Parser (Maybe a) -> a -> Parser a
.!= Int
2
        Parser (Bool -> Bool -> Text -> Text -> Shingle)
-> Parser Bool -> Parser (Bool -> Text -> Text -> Shingle)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ((Maybe StringlyTypedBool -> Maybe Bool)
-> Parser (Maybe StringlyTypedBool) -> Parser (Maybe Bool)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap((Maybe StringlyTypedBool -> Maybe Bool)
 -> Parser (Maybe StringlyTypedBool) -> Parser (Maybe Bool))
-> ((StringlyTypedBool -> Bool)
    -> Maybe StringlyTypedBool -> Maybe Bool)
-> (StringlyTypedBool -> Bool)
-> Parser (Maybe StringlyTypedBool)
-> Parser (Maybe Bool)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(StringlyTypedBool -> Bool)
-> Maybe StringlyTypedBool -> Maybe Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap) StringlyTypedBool -> Bool
unStringlyTypedBool (Object
m Object -> Key -> Parser (Maybe StringlyTypedBool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"output_unigrams") Parser (Maybe Bool) -> Bool -> Parser Bool
forall a. Parser (Maybe a) -> a -> Parser a
.!= Bool
True
        Parser (Bool -> Text -> Text -> Shingle)
-> Parser Bool -> Parser (Text -> Text -> Shingle)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ((Maybe StringlyTypedBool -> Maybe Bool)
-> Parser (Maybe StringlyTypedBool) -> Parser (Maybe Bool)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap((Maybe StringlyTypedBool -> Maybe Bool)
 -> Parser (Maybe StringlyTypedBool) -> Parser (Maybe Bool))
-> ((StringlyTypedBool -> Bool)
    -> Maybe StringlyTypedBool -> Maybe Bool)
-> (StringlyTypedBool -> Bool)
-> Parser (Maybe StringlyTypedBool)
-> Parser (Maybe Bool)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(StringlyTypedBool -> Bool)
-> Maybe StringlyTypedBool -> Maybe Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap) StringlyTypedBool -> Bool
unStringlyTypedBool (Object
m Object -> Key -> Parser (Maybe StringlyTypedBool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"output_unigrams_if_no_shingles") Parser (Maybe Bool) -> Bool -> Parser Bool
forall a. Parser (Maybe a) -> a -> Parser a
.!= Bool
False
        Parser (Text -> Text -> Shingle)
-> Parser Text -> Parser (Text -> Shingle)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
m Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"token_separator" Parser (Maybe Text) -> Text -> Parser Text
forall a. Parser (Maybe a) -> a -> Parser a
.!= Text
" "
        Parser (Text -> Shingle) -> Parser Text -> Parser Shingle
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
m Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"filler_token" Parser (Maybe Text) -> Text -> Parser Text
forall a. Parser (Maybe a) -> a -> Parser a
.!= Text
"_"
      Text
"stemmer" -> Language -> TokenFilterDefinition
TokenFilterDefinitionStemmer
        (Language -> TokenFilterDefinition)
-> Parser Language -> Parser TokenFilterDefinition
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
m Object -> Key -> Parser Language
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"language"
      Text
"stop" -> do
        Value
stop <- Object
m Object -> Key -> Parser Value
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"stopwords"
        Either Language [StopWord]
stop' <- case Value
stop of
          String Text
lang ->
              (Language -> Either Language [StopWord])
-> Parser Language -> Parser (Either Language [StopWord])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Language -> Either Language [StopWord]
forall a b. a -> Either a b
Left
            (Parser Language -> Parser (Either Language [StopWord]))
-> (Text -> Parser Language)
-> Text
-> Parser (Either Language [StopWord])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> Parser Language
forall a. FromJSON a => Value -> Parser a
parseJSON
            (Value -> Parser Language)
-> (Text -> Value) -> Text -> Parser Language
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Value
String
            (Text -> Value) -> (Text -> Text) -> Text -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Text -> Text
T.drop Int
1
            (Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Text -> Text
T.dropEnd Int
1 (Text -> Parser (Either Language [StopWord]))
-> Text -> Parser (Either Language [StopWord])
forall a b. (a -> b) -> a -> b
$ Text
lang
          Value
_ -> [StopWord] -> Either Language [StopWord]
forall a b. b -> Either a b
Right ([StopWord] -> Either Language [StopWord])
-> Parser [StopWord] -> Parser (Either Language [StopWord])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser [StopWord]
forall a. FromJSON a => Value -> Parser a
parseJSON Value
stop
        TokenFilterDefinition -> Parser TokenFilterDefinition
forall (m :: * -> *) a. Monad m => a -> m a
return (Either Language [StopWord] -> TokenFilterDefinition
TokenFilterDefinitionStop Either Language [StopWord]
stop')
      Text
_ -> String -> Parser TokenFilterDefinition
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
"unrecognized token filter type: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Text -> String
T.unpack Text
t)

-- | The set of languages that can be passed to various analyzers,
--   filters, etc. in Elasticsearch. Most data types in this module
--   that have a 'Language' field are actually only actually to
--   handle a subset of these languages. Consult the official
--   Elasticsearch documentation to see what is actually supported.
data Language
  = Arabic
  | Armenian
  | Basque
  | Bengali
  | Brazilian
  | Bulgarian
  | Catalan
  | Cjk
  | Czech
  | Danish
  | Dutch
  | English
  | Finnish
  | French
  | Galician
  | German
  | German2
  | Greek
  | Hindi
  | Hungarian
  | Indonesian
  | Irish
  | Italian
  | Kp
  | Latvian
  | Lithuanian
  | Lovins
  | Norwegian
  | Persian
  | Porter
  | Portuguese
  | Romanian
  | Russian
  | Sorani
  | Spanish
  | Swedish
  | Thai
  | Turkish
  deriving (Language -> Language -> Bool
(Language -> Language -> Bool)
-> (Language -> Language -> Bool) -> Eq Language
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Language -> Language -> Bool
$c/= :: Language -> Language -> Bool
== :: Language -> Language -> Bool
$c== :: Language -> Language -> Bool
Eq, Int -> Language -> ShowS
[Language] -> ShowS
Language -> String
(Int -> Language -> ShowS)
-> (Language -> String) -> ([Language] -> ShowS) -> Show Language
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Language] -> ShowS
$cshowList :: [Language] -> ShowS
show :: Language -> String
$cshow :: Language -> String
showsPrec :: Int -> Language -> ShowS
$cshowsPrec :: Int -> Language -> ShowS
Show)

instance ToJSON Language where
  toJSON :: Language -> Value
toJSON = Text -> Value
String (Text -> Value) -> (Language -> Text) -> Language -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Language -> Text
languageToText

instance FromJSON Language where
  parseJSON :: Value -> Parser Language
parseJSON = String -> (Text -> Parser Language) -> Value -> Parser Language
forall a. String -> (Text -> Parser a) -> Value -> Parser a
withText String
"Language" ((Text -> Parser Language) -> Value -> Parser Language)
-> (Text -> Parser Language) -> Value -> Parser Language
forall a b. (a -> b) -> a -> b
$ \Text
t -> case Text -> Maybe Language
languageFromText Text
t of
    Maybe Language
Nothing -> String -> Parser Language
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"not a supported Elasticsearch language"
    Just Language
lang -> Language -> Parser Language
forall (m :: * -> *) a. Monad m => a -> m a
return Language
lang

languageToText :: Language -> Text
languageToText :: Language -> Text
languageToText Language
x = case Language
x of
  Language
Arabic -> Text
"arabic"
  Language
Armenian -> Text
"armenian"
  Language
Basque -> Text
"basque"
  Language
Bengali -> Text
"bengali"
  Language
Brazilian -> Text
"brazilian"
  Language
Bulgarian -> Text
"bulgarian"
  Language
Catalan -> Text
"catalan"
  Language
Cjk -> Text
"cjk"
  Language
Czech -> Text
"czech"
  Language
Danish -> Text
"danish"
  Language
Dutch -> Text
"dutch"
  Language
English -> Text
"english"
  Language
Finnish -> Text
"finnish"
  Language
French -> Text
"french"
  Language
Galician -> Text
"galician"
  Language
German -> Text
"german"
  Language
German2 -> Text
"german2"
  Language
Greek -> Text
"greek"
  Language
Hindi -> Text
"hindi"
  Language
Hungarian -> Text
"hungarian"
  Language
Indonesian -> Text
"indonesian"
  Language
Irish -> Text
"irish"
  Language
Italian -> Text
"italian"
  Language
Kp -> Text
"kp"
  Language
Latvian -> Text
"latvian"
  Language
Lithuanian -> Text
"lithuanian"
  Language
Lovins -> Text
"lovins"
  Language
Norwegian -> Text
"norwegian"
  Language
Persian -> Text
"persian"
  Language
Porter -> Text
"porter"
  Language
Portuguese -> Text
"portuguese"
  Language
Romanian -> Text
"romanian"
  Language
Russian -> Text
"russian"
  Language
Sorani -> Text
"sorani"
  Language
Spanish -> Text
"spanish"
  Language
Swedish -> Text
"swedish"
  Language
Thai -> Text
"thai"
  Language
Turkish -> Text
"turkish"

languageFromText :: Text -> Maybe Language
languageFromText :: Text -> Maybe Language
languageFromText Text
x = case Text
x of
  Text
"arabic" -> Language -> Maybe Language
forall a. a -> Maybe a
Just Language
Arabic
  Text
"armenian" -> Language -> Maybe Language
forall a. a -> Maybe a
Just Language
Armenian
  Text
"basque" -> Language -> Maybe Language
forall a. a -> Maybe a
Just Language
Basque
  Text
"bengali" -> Language -> Maybe Language
forall a. a -> Maybe a
Just Language
Bengali
  Text
"brazilian" -> Language -> Maybe Language
forall a. a -> Maybe a
Just Language
Brazilian
  Text
"bulgarian" -> Language -> Maybe Language
forall a. a -> Maybe a
Just Language
Bulgarian
  Text
"catalan" -> Language -> Maybe Language
forall a. a -> Maybe a
Just Language
Catalan
  Text
"cjk" -> Language -> Maybe Language
forall a. a -> Maybe a
Just Language
Cjk
  Text
"czech" -> Language -> Maybe Language
forall a. a -> Maybe a
Just Language
Czech
  Text
"danish" -> Language -> Maybe Language
forall a. a -> Maybe a
Just Language
Danish
  Text
"dutch" -> Language -> Maybe Language
forall a. a -> Maybe a
Just Language
Dutch
  Text
"english" -> Language -> Maybe Language
forall a. a -> Maybe a
Just Language
English
  Text
"finnish" -> Language -> Maybe Language
forall a. a -> Maybe a
Just Language
Finnish
  Text
"french" -> Language -> Maybe Language
forall a. a -> Maybe a
Just Language
French
  Text
"galician" -> Language -> Maybe Language
forall a. a -> Maybe a
Just Language
Galician
  Text
"german" -> Language -> Maybe Language
forall a. a -> Maybe a
Just Language
German
  Text
"german2" -> Language -> Maybe Language
forall a. a -> Maybe a
Just Language
German2
  Text
"greek" -> Language -> Maybe Language
forall a. a -> Maybe a
Just Language
Greek
  Text
"hindi" -> Language -> Maybe Language
forall a. a -> Maybe a
Just Language
Hindi
  Text
"hungarian" -> Language -> Maybe Language
forall a. a -> Maybe a
Just Language
Hungarian
  Text
"indonesian" -> Language -> Maybe Language
forall a. a -> Maybe a
Just Language
Indonesian
  Text
"irish" -> Language -> Maybe Language
forall a. a -> Maybe a
Just Language
Irish
  Text
"italian" -> Language -> Maybe Language
forall a. a -> Maybe a
Just Language
Italian
  Text
"kp" -> Language -> Maybe Language
forall a. a -> Maybe a
Just Language
Kp
  Text
"latvian" -> Language -> Maybe Language
forall a. a -> Maybe a
Just Language
Latvian
  Text
"lithuanian" -> Language -> Maybe Language
forall a. a -> Maybe a
Just Language
Lithuanian
  Text
"lovins" -> Language -> Maybe Language
forall a. a -> Maybe a
Just Language
Lovins
  Text
"norwegian" -> Language -> Maybe Language
forall a. a -> Maybe a
Just Language
Norwegian
  Text
"persian" -> Language -> Maybe Language
forall a. a -> Maybe a
Just Language
Persian
  Text
"porter" -> Language -> Maybe Language
forall a. a -> Maybe a
Just Language
Porter
  Text
"portuguese" -> Language -> Maybe Language
forall a. a -> Maybe a
Just Language
Portuguese
  Text
"romanian" -> Language -> Maybe Language
forall a. a -> Maybe a
Just Language
Romanian
  Text
"russian" -> Language -> Maybe Language
forall a. a -> Maybe a
Just Language
Russian
  Text
"sorani" -> Language -> Maybe Language
forall a. a -> Maybe a
Just Language
Sorani
  Text
"spanish" -> Language -> Maybe Language
forall a. a -> Maybe a
Just Language
Spanish
  Text
"swedish" -> Language -> Maybe Language
forall a. a -> Maybe a
Just Language
Swedish
  Text
"thai" -> Language -> Maybe Language
forall a. a -> Maybe a
Just Language
Thai
  Text
"turkish" -> Language -> Maybe Language
forall a. a -> Maybe a
Just Language
Turkish
  Text
_ -> Maybe Language
forall a. Maybe a
Nothing

data Shingle = Shingle
  { Shingle -> Int
shingleMaxSize :: Int
  , Shingle -> Int
shingleMinSize :: Int
  , Shingle -> Bool
shingleOutputUnigrams :: Bool
  , Shingle -> Bool
shingleOutputUnigramsIfNoShingles :: Bool
  , Shingle -> Text
shingleTokenSeparator :: Text
  , Shingle -> Text
shingleFillerToken :: Text
  } deriving (Shingle -> Shingle -> Bool
(Shingle -> Shingle -> Bool)
-> (Shingle -> Shingle -> Bool) -> Eq Shingle
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Shingle -> Shingle -> Bool
$c/= :: Shingle -> Shingle -> Bool
== :: Shingle -> Shingle -> Bool
$c== :: Shingle -> Shingle -> Bool
Eq, Int -> Shingle -> ShowS
[Shingle] -> ShowS
Shingle -> String
(Int -> Shingle -> ShowS)
-> (Shingle -> String) -> ([Shingle] -> ShowS) -> Show Shingle
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Shingle] -> ShowS
$cshowList :: [Shingle] -> ShowS
show :: Shingle -> String
$cshow :: Shingle -> String
showsPrec :: Int -> Shingle -> ShowS
$cshowsPrec :: Int -> Shingle -> ShowS
Show)