never executed always true always false

    1 module Conjure.LSP.Handlers.DocumentSymbol where
    2 
    3 import Conjure.LSP.Util (ProcessedFile (ProcessedFile), regionToRange, withProcessedDoc)
    4 import Conjure.Language (Type (..))
    5 import Conjure.Language.Pretty (prettyT)
    6 import Conjure.Language.Type (IntTag (..))
    7 import Conjure.Language.Validator (Class (..), Kind (..), RegionInfo (..), RegionType (..), StructuralType (..), ValidatorState (regionInfo))
    8 import Conjure.Prelude
    9 import Control.Lens
   10 import Data.Text (intercalate)
   11 import Language.LSP.Protocol.Lens (HasParams (..), HasTextDocument (textDocument))
   12 import Language.LSP.Protocol.Message
   13 import Language.LSP.Protocol.Types (DocumentSymbol (..), SymbolKind (..), type (|?) (..))
   14 import Language.LSP.Protocol.Types qualified as T
   15 import Language.LSP.Server (Handlers, LspM, requestHandler)
   16 
   17 docSymbolHandler :: Handlers (LspM ())
   18 docSymbolHandler = requestHandler SMethod_TextDocumentDocumentSymbol $ \req res -> do
   19   let ps = req ^. params . textDocument
   20   withProcessedDoc ps $ \(ProcessedFile _ _ (regionInfo -> ri) _) -> do
   21     res $ Right $ InR $ InL $ mapMaybe translate ri
   22 
   23 translate :: RegionInfo -> Maybe T.DocumentSymbol
   24 translate reg@(RegionInfo r rSel ty cs _) =
   25   ( \x ->
   26       DocumentSymbol
   27         (getRegionName reg)
   28         (getRegionDetail reg)
   29         x
   30         Nothing
   31         Nothing
   32         (regionToRange r)
   33         (regionToRange (fromMaybe r rSel))
   34         (Just $ mapMaybe translate cs)
   35   )
   36     <$> sk
   37   where
   38     sk = symbolKindFromDeclaration ty
   39 
   40 getRegionName :: RegionInfo -> Text
   41 getRegionName (rRegionType -> rType) = case rType of
   42   Definition txt _ -> txt
   43   LiteralDecl _ -> "Literal"
   44   Ref txt _ _ -> txt
   45   Structural st -> case st of
   46     SSuchThat -> "Constraints"
   47     SGiven -> "Parameters"
   48     SFind -> "Decision Variables"
   49     SLetting -> "Definitions"
   50     SEnum txt -> txt
   51     SBranching -> "Branch"
   52     SQuantification n _ -> "Quantification: " `mappend` n
   53     SComprehension _ -> "Comprehension"
   54     SBody -> "Body"
   55     SGuard -> "Guard"
   56     SGen -> "Generator"
   57     SWhere -> "Parameter validation"
   58     SGoal dir -> dir
   59   Documentation _ _ -> ""
   60 
   61 getRegionDetail :: RegionInfo -> Maybe Text
   62 getRegionDetail (RegionInfo {rRegionType = rType, rChildren = childDefs}) =
   63   case rType of
   64     Definition _ ki -> Just $ prettyT ki
   65     LiteralDecl ki -> Just $ prettyT ki
   66     Ref _ ki _ -> Just $ prettyT ki
   67     Structural st -> case st of
   68       SSuchThat -> Nothing
   69       SGiven -> Just $ getDefs childDefs
   70       SFind -> Just $ getDefs childDefs
   71       SLetting -> Just $ getDefs childDefs
   72       SEnum _ -> Just "new type enum"
   73       SQuantification _ ki -> Just $ prettyT ki
   74       SComprehension ki -> Just $ prettyT ki
   75       _ -> Nothing
   76     Documentation {} -> Nothing
   77   where
   78     getDefs :: [RegionInfo] -> Text
   79     getDefs rs = Data.Text.intercalate ", " [nm | Definition nm _ <- rRegionType <$> rs]
   80 
   81 symbolKindFromDeclaration :: RegionType -> Maybe T.SymbolKind
   82 symbolKindFromDeclaration (Definition _ t) = Just $ case t of
   83   Kind ValueType {} (TypeInt TagEnum {}) -> SymbolKind_EnumMember
   84   Kind ValueType {} (TypeRecordMember {}) -> SymbolKind_Field
   85   Kind ValueType {} (TypeVariantMember {}) -> SymbolKind_Field
   86   Kind ValueType {} _ -> SymbolKind_Variable
   87   Kind DomainType _ -> SymbolKind_TypeParameter
   88 symbolKindFromDeclaration (LiteralDecl t) = Just $ case t of
   89   Kind _ ty -> case ty of
   90     TypeBool -> SymbolKind_Boolean
   91     TypeInt it -> case it of
   92       TagInt -> SymbolKind_Number
   93       TagEnum _ -> SymbolKind_EnumMember
   94       TagUnnamed _ -> SymbolKind_Number
   95     TypeEnum _ -> SymbolKind_Enum
   96     TypeUnnamed _ -> SymbolKind_Enum
   97     _ -> SymbolKind_Constant
   98 symbolKindFromDeclaration (Structural st) =
   99   Just
  100     ( case st of
  101         SSuchThat -> SymbolKind_Interface
  102         SGiven -> SymbolKind_Property
  103         SFind -> SymbolKind_Field
  104         SLetting -> SymbolKind_Field
  105         SBranching -> SymbolKind_Class
  106         SEnum _ -> SymbolKind_Enum
  107         SQuantification _ _ -> SymbolKind_Operator
  108         SComprehension _ -> SymbolKind_Array
  109         SGuard -> SymbolKind_Boolean
  110         SGen -> SymbolKind_Event
  111         SBody -> SymbolKind_Namespace
  112         SGoal _ -> SymbolKind_Variable
  113         SWhere -> SymbolKind_Object
  114     )
  115 symbolKindFromDeclaration _ = Nothing