content: {-# LANGUAGE OverloadedStrings #-}
  
  module Database.Bloodhound.Internal.Versions.Common.Types.Analysis where
  
  import qualified Data.Map.Strict as M
  import qualified Data.Text as T
  import Database.Bloodhound.Internal.Utils.Imports
  import Database.Bloodhound.Internal.Utils.StringlyTyped
  import Database.Bloodhound.Internal.Versions.Common.Types.Newtypes
  import GHC.Generics
  
  data Analysis = Analysis
    { analysisAnalyzer :: M.Map Text AnalyzerDefinition,
      analysisTokenizer :: M.Map Text TokenizerDefinition,
      analysisTokenFilter :: M.Map Text TokenFilterDefinition,
      analysisCharFilter :: M.Map Text CharFilterDefinition
    }
    deriving stock (Eq, Show, Generic)
  
  instance ToJSON Analysis where
    toJSON (Analysis analyzer tokenizer tokenFilter charFilter) =
      object
        [ "analyzer" .= analyzer,
          "tokenizer" .= tokenizer,
          "filter" .= tokenFilter,
          "char_filter" .= charFilter
        ]
  
  instance FromJSON Analysis where
    parseJSON = withObject "Analysis" $ \m ->
      Analysis
        <$> m
          .: "analyzer"
        <*> m
          .:? "tokenizer"
          .!= M.empty
        <*> m
          .:? "filter"
          .!= M.empty
        <*> m
          .:? "char_filter"
          .!= M.empty
  
  analysisAnalyzerLens :: Lens' Analysis (M.Map Text AnalyzerDefinition)
  analysisAnalyzerLens = lens analysisAnalyzer (\x y -> x {analysisAnalyzer = y})
  
  analysisTokenizerLens :: Lens' Analysis (M.Map Text TokenizerDefinition)
  analysisTokenizerLens = lens analysisTokenizer (\x y -> x {analysisTokenizer = y})
  
  analysisTokenFilterLens :: Lens' Analysis (M.Map Text TokenFilterDefinition)
  analysisTokenFilterLens = lens analysisTokenFilter (\x y -> x {analysisTokenFilter = y})
  
  analysisCharFilterLens :: Lens' Analysis (M.Map Text CharFilterDefinition)
  analysisCharFilterLens = lens analysisCharFilter (\x y -> x {analysisCharFilter = y})
  
  newtype Tokenizer
    = Tokenizer Text
    deriving newtype (Eq, Show, ToJSON, FromJSON)
  
  data AnalyzerDefinition = AnalyzerDefinition
    { analyzerDefinitionTokenizer :: Maybe Tokenizer,
      analyzerDefinitionFilter :: [TokenFilter],
      analyzerDefinitionCharFilter :: [CharFilter]
    }
    deriving stock (Eq, Show, Generic)
  
  instance ToJSON AnalyzerDefinition where
    toJSON (AnalyzerDefinition tokenizer tokenFilter charFilter) =
      object $
        catMaybes
          [ fmap ("tokenizer" .=) tokenizer,
            Just $ "filter" .= tokenFilter,
            Just $ "char_filter" .= charFilter
          ]
  
  instance FromJSON AnalyzerDefinition where
    parseJSON = withObject "AnalyzerDefinition" $ \m ->
      AnalyzerDefinition
        <$> m .:? "tokenizer"
        <*> m .:? "filter" .!= []
        <*> m .:? "char_filter" .!= []
  
  analyzerDefinitionTokenizerLens :: Lens' AnalyzerDefinition (Maybe Tokenizer)
  analyzerDefinitionTokenizerLens = lens analyzerDefinitionTokenizer (\x y -> x {analyzerDefinitionTokenizer = y})
  
  analyzerDefinitionFilterLens :: Lens' AnalyzerDefinition [TokenFilter]
  analyzerDefinitionFilterLens = lens analyzerDefinitionFilter (\x y -> x {analyzerDefinitionFilter = y})
  
  analyzerDefinitionCharFilterLens :: Lens' AnalyzerDefinition [CharFilter]
  analyzerDefinitionCharFilterLens = lens analyzerDefinitionCharFilter (\x y -> x {analyzerDefinitionCharFilter = y})
  
  -- | 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
        { charFilterDefinitionPatternReplacePattern :: Text,
          charFilterDefinitionPatternReplaceReplacement :: Text,
          charFilterDefinitionPatternReplaceFlags :: Maybe Text
        }
    deriving stock (Eq, Show)
  
  instance ToJSON CharFilterDefinition where
    toJSON (CharFilterDefinitionMapping ms) =
      object
        [ "type" .= ("mapping" :: Text),
          "mappings" .= [a <> " => " <> b | (a, b) <- M.toList ms]
        ]
    toJSON (CharFilterDefinitionPatternReplace pat repl flags) =
      object $
        [ "type" .= ("pattern_replace" :: Text),
          "pattern" .= pat,
          "replacement" .= repl
        ]
          ++ maybe [] (\f -> ["flags" .= f]) flags
  
  instance FromJSON CharFilterDefinition where
    parseJSON = withObject "CharFilterDefinition" $ \m -> do
      t <- m .: "type"
      case (t :: Text) of
        "mapping" -> CharFilterDefinitionMapping . M.fromList <$> ms
          where
            ms = m .: "mappings" >>= mapM parseMapping
            parseMapping kv = case T.splitOn "=>" kv of
              (k : vs) -> pure (T.strip k, T.strip $ T.concat vs)
              _ -> fail "mapping is not of the format key => value"
        "pattern_replace" ->
          CharFilterDefinitionPatternReplace
            <$> m
              .: "pattern"
            <*> m
              .: "replacement"
            <*> m
              .:? "flags"
        _ -> fail ("unrecognized character filter type: " ++ T.unpack t)
  
  data TokenizerDefinition
    = TokenizerDefinitionNgram Ngram
    | TokenizerDefinitionEdgeNgram Ngram
    deriving stock (Eq, Show, Generic)
  
  instance ToJSON TokenizerDefinition where
    toJSON x =
      case x of
        TokenizerDefinitionNgram ngram ->
          object (["type" .= ("ngram" :: Text)] <> ngramToObject ngram)
        TokenizerDefinitionEdgeNgram ngram ->
          object (["type" .= ("edge_ngram" :: Text)] <> ngramToObject ngram)
      where
        ngramToObject (Ngram minGram maxGram tokenChars) =
          [ "min_gram" .= minGram,
            "max_gram" .= maxGram,
            "token_chars" .= tokenChars
          ]
  
  instance FromJSON TokenizerDefinition where
    parseJSON = withObject "TokenizerDefinition" $ \m -> do
      typ <- m .: "type" :: Parser Text
      case typ of
        "ngram" ->
          TokenizerDefinitionNgram <$> parseNgram m
        "edge_ngram" ->
          TokenizerDefinitionEdgeNgram <$> parseNgram m
        _ -> fail $ "invalid TokenizerDefinition type: " <> T.unpack typ
      where
        parseNgram m =
          Ngram
            <$> fmap unStringlyTypedInt (m .: "min_gram")
            <*> fmap unStringlyTypedInt (m .: "max_gram")
            <*> m
              .: "token_chars"
  
  data Ngram = Ngram
    { ngramMinGram :: Int,
      ngramMaxGram :: Int,
      ngramTokenChars :: [TokenChar]
    }
    deriving stock (Eq, Show, Generic)
  
  data TokenChar
    = TokenLetter
    | TokenDigit
    | TokenWhitespace
    | TokenPunctuation
    | TokenSymbol
    deriving stock (Eq, Show, Generic)
  
  instance ToJSON TokenChar where
    toJSON t = String $ case t of
      TokenLetter -> "letter"
      TokenDigit -> "digit"
      TokenWhitespace -> "whitespace"
      TokenPunctuation -> "punctuation"
      TokenSymbol -> "symbol"
  
  instance FromJSON TokenChar where
    parseJSON = withText "TokenChar" $ \t -> case t of
      "letter" -> return TokenLetter
      "digit" -> return TokenDigit
      "whitespace" -> return TokenWhitespace
      "punctuation" -> return TokenPunctuation
      "symbol" -> return TokenSymbol
      _ -> fail "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])
    | TokenFilterDefinitionEdgeNgram NgramFilter (Maybe EdgeNgramFilterSide)
    | TokenFilterDefinitionNgram NgramFilter
    | TokenFilterTruncate Int
    deriving stock (Eq, Show, Generic)
  
  instance ToJSON TokenFilterDefinition where
    toJSON x = case x of
      TokenFilterDefinitionLowercase mlang ->
        object $
          catMaybes
            [ Just $ "type" .= ("lowercase" :: Text),
              fmap (\lang -> "language" .= languageToText lang) mlang
            ]
      TokenFilterDefinitionUppercase mlang ->
        object $
          catMaybes
            [ Just $ "type" .= ("uppercase" :: Text),
              fmap (\lang -> "language" .= languageToText lang) mlang
            ]
      TokenFilterDefinitionApostrophe ->
        object
          [ "type" .= ("apostrophe" :: Text)
          ]
      TokenFilterDefinitionReverse ->
        object
          [ "type" .= ("reverse" :: Text)
          ]
      TokenFilterDefinitionSnowball lang ->
        object
          [ "type" .= ("snowball" :: Text),
            "language" .= languageToText lang
          ]
      TokenFilterDefinitionShingle s ->
        object
          [ "type" .= ("shingle" :: Text),
            "max_shingle_size" .= shingleMaxSize s,
            "min_shingle_size" .= shingleMinSize s,
            "output_unigrams" .= shingleOutputUnigrams s,
            "output_unigrams_if_no_shingles" .= shingleOutputUnigramsIfNoShingles s,
            "token_separator" .= shingleTokenSeparator s,
            "filler_token" .= shingleFillerToken s
          ]
      TokenFilterDefinitionStemmer lang ->
        object
          [ "type" .= ("stemmer" :: Text),
            "language" .= languageToText lang
          ]
      TokenFilterDefinitionStop stop ->
        object
          [ "type" .= ("stop" :: Text),
            "stopwords" .= case stop of
              Left lang -> String $ "_" <> languageToText lang <> "_"
              Right stops -> toJSON stops
          ]
      TokenFilterDefinitionEdgeNgram ngram side ->
        object
          ( [ "type" .= ("edge_ngram" :: Text),
              "side" .= side
            ]
              <> ngramFilterToPairs ngram
          )
      TokenFilterDefinitionNgram ngram ->
        object
          ( ["type" .= ("ngram" :: Text)]
              <> ngramFilterToPairs ngram
          )
      TokenFilterTruncate n ->
        object
          [ "type" .= ("truncate" :: Text),
            "length" .= n
          ]
  
  instance FromJSON TokenFilterDefinition where
    parseJSON = withObject "TokenFilterDefinition" $ \m -> do
      t <- m .: "type"
      case (t :: Text) of
        "reverse" -> return TokenFilterDefinitionReverse
        "apostrophe" -> return TokenFilterDefinitionApostrophe
        "lowercase" ->
          TokenFilterDefinitionLowercase
            <$> m .:? "language"
        "uppercase" ->
          TokenFilterDefinitionUppercase
            <$> m .:? "language"
        "snowball" ->
          TokenFilterDefinitionSnowball
            <$> m
              .: "language"
        "shingle" ->
          fmap TokenFilterDefinitionShingle $
            Shingle
              <$> (fmap . fmap) unStringlyTypedInt (m .:? "max_shingle_size") .!= 2
              <*> (fmap . fmap) unStringlyTypedInt (m .:? "min_shingle_size") .!= 2
              <*> (fmap . fmap) unStringlyTypedBool (m .:? "output_unigrams") .!= True
              <*> (fmap . fmap) unStringlyTypedBool (m .:? "output_unigrams_if_no_shingles") .!= False
              <*> m .:? "token_separator" .!= " "
              <*> m .:? "filler_token" .!= "_"
        "stemmer" ->
          TokenFilterDefinitionStemmer
            <$> m
              .: "language"
        "stop" -> do
          stop <- m .: "stopwords"
          stop' <- case stop of
            String lang ->
              fmap Left
                . parseJSON
                . String
                . T.drop 1
                . T.dropEnd 1
                $ lang
            _ -> Right <$> parseJSON stop
          return (TokenFilterDefinitionStop stop')
        "edge_ngram" ->
          TokenFilterDefinitionEdgeNgram
            <$> ngramFilterFromJSONObject m
            <*> m
              .: "side"
        "ngram" -> TokenFilterDefinitionNgram <$> ngramFilterFromJSONObject m
        "truncate" -> TokenFilterTruncate <$> m .:? "length" .!= 10
        _ -> fail ("unrecognized token filter type: " ++ T.unpack t)
  
  data NgramFilter = NgramFilter
    { ngramFilterMinGram :: Int,
      ngramFilterMaxGram :: Int
    }
    deriving stock (Eq, Show, Generic)
  
  ngramFilterToPairs :: NgramFilter -> [Pair]
  ngramFilterToPairs (NgramFilter minGram maxGram) =
    ["min_gram" .= minGram, "max_gram" .= maxGram]
  
  ngramFilterFromJSONObject :: Object -> Parser NgramFilter
  ngramFilterFromJSONObject o =
    NgramFilter
      <$> o
        .: "min_gram"
        .!= 1
      <*> o
        .: "max_gram"
        .!= 2
  
  data EdgeNgramFilterSide
    = EdgeNgramFilterSideFront
    | EdgeNgramFilterSideBack
    deriving stock (Eq, Show, Generic)
  
  instance ToJSON EdgeNgramFilterSide where
    toJSON EdgeNgramFilterSideFront = String "front"
    toJSON EdgeNgramFilterSideBack = String "back"
  
  instance FromJSON EdgeNgramFilterSide where
    parseJSON = withText "EdgeNgramFilterSide" $ \t ->
      case t of
        "front" -> pure EdgeNgramFilterSideFront
        "back" -> pure EdgeNgramFilterSideBack
        _ -> fail $ "EdgeNgramFilterSide can only be 'front' or 'back', found: " <> T.unpack 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 stock (Eq, Show, Generic)
  
  instance ToJSON Language where
    toJSON = String . languageToText
  
  instance FromJSON Language where
    parseJSON = withText "Language" $ \t -> case languageFromText t of
      Nothing -> fail "not a supported Elasticsearch language"
      Just lang -> return lang
  
  languageToText :: Language -> Text
  languageToText x = case x of
    Arabic -> "arabic"
    Armenian -> "armenian"
    Basque -> "basque"
    Bengali -> "bengali"
    Brazilian -> "brazilian"
    Bulgarian -> "bulgarian"
    Catalan -> "catalan"
    Cjk -> "cjk"
    Czech -> "czech"
    Danish -> "danish"
    Dutch -> "dutch"
    English -> "english"
    Finnish -> "finnish"
    French -> "french"
    Galician -> "galician"
    German -> "german"
    German2 -> "german2"
    Greek -> "greek"
    Hindi -> "hindi"
    Hungarian -> "hungarian"
    Indonesian -> "indonesian"
    Irish -> "irish"
    Italian -> "italian"
    Kp -> "kp"
    Latvian -> "latvian"
    Lithuanian -> "lithuanian"
    Lovins -> "lovins"
    Norwegian -> "norwegian"
    Persian -> "persian"
    Porter -> "porter"
    Portuguese -> "portuguese"
    Romanian -> "romanian"
    Russian -> "russian"
    Sorani -> "sorani"
    Spanish -> "spanish"
    Swedish -> "swedish"
    Thai -> "thai"
    Turkish -> "turkish"
  
  languageFromText :: Text -> Maybe Language
  languageFromText x = case x of
    "arabic" -> Just Arabic
    "armenian" -> Just Armenian
    "basque" -> Just Basque
    "bengali" -> Just Bengali
    "brazilian" -> Just Brazilian
    "bulgarian" -> Just Bulgarian
    "catalan" -> Just Catalan
    "cjk" -> Just Cjk
    "czech" -> Just Czech
    "danish" -> Just Danish
    "dutch" -> Just Dutch
    "english" -> Just English
    "finnish" -> Just Finnish
    "french" -> Just French
    "galician" -> Just Galician
    "german" -> Just German
    "german2" -> Just German2
    "greek" -> Just Greek
    "hindi" -> Just Hindi
    "hungarian" -> Just Hungarian
    "indonesian" -> Just Indonesian
    "irish" -> Just Irish
    "italian" -> Just Italian
    "kp" -> Just Kp
    "latvian" -> Just Latvian
    "lithuanian" -> Just Lithuanian
    "lovins" -> Just Lovins
    "norwegian" -> Just Norwegian
    "persian" -> Just Persian
    "porter" -> Just Porter
    "portuguese" -> Just Portuguese
    "romanian" -> Just Romanian
    "russian" -> Just Russian
    "sorani" -> Just Sorani
    "spanish" -> Just Spanish
    "swedish" -> Just Swedish
    "thai" -> Just Thai
    "turkish" -> Just Turkish
    _ -> Nothing
  
  data Shingle = Shingle
    { shingleMaxSize :: Int,
      shingleMinSize :: Int,
      shingleOutputUnigrams :: Bool,
      shingleOutputUnigramsIfNoShingles :: Bool,
      shingleTokenSeparator :: Text,
      shingleFillerToken :: Text
    }
    deriving stock (Eq, Show, Generic)
  
  shingleMaxSizeLens :: Lens' Shingle Int
  shingleMaxSizeLens = lens shingleMaxSize (\x y -> x {shingleMaxSize = y})
  
  shingleMinSizeLens :: Lens' Shingle Int
  shingleMinSizeLens = lens shingleMinSize (\x y -> x {shingleMinSize = y})
  
  shingleOutputUnigramsLens :: Lens' Shingle Bool
  shingleOutputUnigramsLens = lens shingleOutputUnigrams (\x y -> x {shingleOutputUnigrams = y})
  
  shingleOutputUnigramsIfNoShinglesLens :: Lens' Shingle Bool
  shingleOutputUnigramsIfNoShinglesLens = lens shingleOutputUnigramsIfNoShingles (\x y -> x {shingleOutputUnigramsIfNoShingles = y})
  
  shingleTokenSeparatorLens :: Lens' Shingle Text
  shingleTokenSeparatorLens = lens shingleTokenSeparator (\x y -> x {shingleTokenSeparator = y})
  
  shingleFillerTokenLens :: Lens' Shingle Text
  shingleFillerTokenLens = lens shingleFillerToken (\x y -> x {shingleFillerToken = y})
  