{-
  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.
-}

{-# OPTIONS_GHC -Wno-orphans #-}

module Glean.Glass.SymbolId.Hs ({- instances -}) where

import Data.Char
import qualified Data.Text as Text
import TextShow

import Glean.Glass.SymbolId.Class
import Glean.Glass.Types (Name(..))
import Glean.Schema.CodeHs.Types as Hs (Entity(..))
import qualified Glean
import qualified Glean.Schema.Hs.Types as Hs
import qualified Glean.Schema.Src.Types as Src

-- REPO/hs/containers/Data/Map/{var|datacon|tyvar|tycon}/toList[/START/END]

instance Symbol Hs.Entity where
  toSymbol (Hs.Entity_name x) = toSymbolPredicate x
  toSymbol (Hs.Entity_mod x) = toSymbolPredicate x
  toSymbol _ = error "toSymbol: unknown Hs.Entity"

instance Symbol Hs.Name_key where
  toSymbol (Hs.Name_key occ mod sort) = do
    m <- toSymbol mod
    o <- toSymbol occ
    s <- toSymbol sort
    return $ m <> o <> s

instance Symbol Hs.Module where
  toSymbol = toSymbolPredicate

instance Symbol Hs.OccName where
  toSymbol = toSymbolPredicate

instance Symbol Hs.Module_key where
  toSymbol (Hs.Module_key name unit) = do
    u <- Glean.keyOf unit
    n <- Glean.keyOf name
    -- unit names are things like glean-0.1.0.0-inplace-core
    -- let's strip the version and everything after it
    let pkg = Text.intercalate "-" (fst (break isVer (Text.splitOn "-" u)))
    return (pkg : Text.splitOn "." n)
    where
    isVer t
      | Just (d, _) <- Text.uncons t = isDigit d
      | otherwise = False

instance Symbol Hs.OccName_key where
  toSymbol (Hs.OccName_key name namespace) = do
    let sp = case namespace of
          Hs.Namespace_var_ -> "var"
          Hs.Namespace_datacon -> "con"
          Hs.Namespace_tyvar -> "tyvar"
          Hs.Namespace_tycon -> "ty"
          _ -> error "namespace"
    return [sp,name]

instance Symbol Hs.NameSort where
  toSymbol Hs.NameSort_external{} = return []
  toSymbol (Hs.NameSort_internal (Src.ByteSpan start end)) =
    return [showt (Glean.fromNat start), showt (Glean.fromNat end)]
  toSymbol _ = error "toSymbol: unknown Hs.NameSort"

instance ToQName Hs.Entity where
  toQName (Hs.Entity_name n) = Glean.keyOf n >>= toQName
  toQName (Hs.Entity_mod mod) = do
    Hs.Module_key m _ <- Glean.keyOf mod
    modname <- Glean.keyOf m
    return $ Right (Name modname, Name "")
  toQName _ = error "ToQName: unknown Hs.Entity"

instance ToQName Hs.Name_key where
  toQName (Hs.Name_key occ mod _) = do
    Hs.Module_key m _ <- Glean.keyOf mod
    modname <- Glean.keyOf m
    Hs.OccName_key n _ <- Glean.keyOf occ
    return $ Right (Name n, Name modname)