{-
  Copyright (c) Meta Platforms, Inc. and affiliates.
  All rights reserved.

  This source code is licensed under the BSD-style license found in the
  LICENSE file in the root directory of this source tree.
-}

{-# LANGUAGE TypeApplications #-}
{-# OPTIONS_GHC -Wno-orphans #-}

module Glean.Glass.Search.Haskell
  ( {- instances -}
  ) where

import Data.Text ( Text )
import qualified Data.Text as Text ( intercalate )
import Util.Text

import Glean.Angle as Angle

import Glean.Glass.Search.Class

import qualified Glean.Schema.CodeHs.Types as Haskell
import qualified Glean.Schema.Hs.Types as Hs

instance Search (ResultLocation Haskell.Entity) where
  symbolSearch [] = return $ None "Haskell.symbolSearch: empty"
  symbolSearch toks@(pkg : rest) = do
    case reverse rest of
      end : start : ident : namespace : mod
        | Right e <- textToInt end,
          Right s <- textToInt start,
          Just ns <- fromNamespace namespace ->
          searchSymbolId toks $
            symbolIdQuery pkg (Text.intercalate "." (reverse mod)) ident ns
              (Just (s,e))
      ident : namespace : mod
        | Just ns <- fromNamespace namespace ->
          searchSymbolId toks $
            symbolIdQuery pkg (Text.intercalate "." (reverse mod)) ident ns
              Nothing
      _ -> return $ None "Haskell.symbolSearch: empty"
    where
    fromNamespace "var" = Just Hs.Namespace_var_
    fromNamespace "ty" = Just Hs.Namespace_tycon
    fromNamespace "con" = Just Hs.Namespace_datacon
    fromNamespace "tyvar" = Just Hs.Namespace_tyvar
    fromNamespace _ = Nothing


symbolIdQuery
  :: Text  -- ^ package
  -> Text  -- ^ module name
  -> Text  -- ^ identifier
  -> Hs.Namespace -- ^ namespace (var, datacon, tycon, tyvar)
  -> Maybe (Int, Int)  -- ^ span, for local names
  -> Angle (ResultLocation Haskell.Entity)
symbolIdQuery pkg mod ident ns sort =
  vars $ \name file span ->
    tuple (
      alt @"name" (asPredicate name),
      file,
      alt @"span" span,
      string ident
    ) `where_` [
        name .= predicate @Hs.Name (
          rec $
            field @"occ" (rec $
              field @"name" (string ident) $
              field @"namespace_" (enum ns) end) $
            field @"mod" (rec $
              field @"name" (string mod) $
              field @"unit" (stringPrefix pkg) end) $
            field @"sort" (
              case sort of
                Nothing -> alt @"external" wild
                Just (s,l) -> alt @"internal" (rec $
                  field @"start" (nat (fromIntegral s)) $
                  field @"length" (nat (fromIntegral l)) end)
            ) end),
        stmt $ predicate @Hs.DeclarationLocation (
          rec $
            field @"name" (asPredicate name) $
            field @"file" (asPredicate file) $
            field @"span" span end
        )
    ]