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.Server (Handlers, LspM, requestHandler)
   12 import Language.LSP.Types (DocumentSymbol (..), SMethod (STextDocumentDocumentSymbol), SymbolKind (..), type (|?) (..))
   13 import Language.LSP.Types qualified as T
   14 import Language.LSP.Types.Lens (HasParams (..), HasTextDocument (textDocument))
   15 
   16 docSymbolHandler :: Handlers (LspM ())
   17 docSymbolHandler = requestHandler STextDocumentDocumentSymbol $ \req res -> do
   18   let ps = req ^. params . textDocument
   19   withProcessedDoc ps $ \(ProcessedFile _ _ (regionInfo -> ri) _) -> do
   20     res $ Right $ InL . T.List $ mapMaybe translate ri
   21 
   22 translate :: RegionInfo -> Maybe T.DocumentSymbol
   23 translate reg@(RegionInfo r rSel ty cs _) =
   24   ( \x ->
   25       DocumentSymbol
   26         (getRegionName reg)
   27         (getRegionDetail reg)
   28         x
   29         Nothing
   30         Nothing
   31         (regionToRange r)
   32         (regionToRange (fromMaybe r rSel))
   33         (Just . T.List $ mapMaybe translate cs)
   34   )
   35     <$> sk
   36   where
   37     sk = symbolKindFromDeclaration ty
   38 
   39 getRegionName :: RegionInfo -> Text
   40 getRegionName (rRegionType -> rType) = case rType of
   41   Definition txt _ -> txt
   42   LiteralDecl _ -> "Literal"
   43   Ref txt _ _ -> txt
   44   Structural st -> case st of
   45     SSuchThat -> "Constraints"
   46     SGiven -> "Parameters"
   47     SFind -> "Decision Variables"
   48     SLetting -> "Definitions"
   49     SEnum txt -> txt
   50     SBranching -> "Branch"
   51     SQuantification n _ -> "Quantification: " `mappend` n
   52     SComprehension _ -> "Comprehension"
   53     SBody -> "Body"
   54     SGuard -> "Guard"
   55     SGen -> "Generator"
   56     SWhere -> "Parameter validation"
   57     SGoal dir -> dir
   58   Documentation _ _ -> ""
   59 
   60 getRegionDetail :: RegionInfo -> Maybe Text
   61 getRegionDetail (RegionInfo {rRegionType = rType, rChildren = childDefs}) =
   62   case rType of
   63     Definition _ ki -> Just $ prettyT ki
   64     LiteralDecl ki -> Just $ prettyT ki
   65     Ref _ ki _ -> Just $ prettyT ki
   66     Structural st -> case st of
   67       SSuchThat -> Nothing
   68       SGiven -> Just $ getDefs childDefs
   69       SFind -> Just $ getDefs childDefs
   70       SLetting -> Just $ getDefs childDefs
   71       SEnum _ -> Just "new type enum"
   72       SQuantification _ ki -> Just $ prettyT ki
   73       SComprehension ki -> Just $ prettyT ki
   74       _ -> Nothing
   75     Documentation {} -> Nothing
   76   where
   77     getDefs :: [RegionInfo] -> Text
   78     getDefs rs = Data.Text.intercalate ", " [nm | Definition nm _ <- rRegionType <$> rs]
   79 
   80 symbolKindFromDeclaration :: RegionType -> Maybe T.SymbolKind
   81 symbolKindFromDeclaration (Definition _ t) = Just $ case t of
   82   Kind ValueType {} (TypeInt TagEnum {}) -> SkEnumMember
   83   Kind ValueType {} (TypeRecordMember {}) -> SkField
   84   Kind ValueType {} (TypeVariantMember {}) -> SkField
   85   Kind ValueType {} _ -> SkVariable
   86   Kind DomainType _ -> SkTypeParameter
   87 symbolKindFromDeclaration (LiteralDecl t) = Just $ case t of
   88   Kind _ ty -> case ty of
   89     TypeBool -> SkBoolean
   90     TypeInt it -> case it of
   91       TagInt -> SkNumber
   92       TagEnum _ -> SkEnumMember
   93       TagUnnamed _ -> SkNumber
   94     TypeEnum _ -> SkEnum
   95     TypeUnnamed _ -> SkEnum
   96     _ -> SkConstant
   97 symbolKindFromDeclaration (Structural st) =
   98   Just
   99     $ ( case st of
  100           SSuchThat -> SkInterface
  101           SGiven -> SkProperty
  102           SFind -> SkField
  103           SLetting -> SkField
  104           SBranching -> SkClass
  105           SEnum _ -> SkEnum
  106           SQuantification _ _ -> SkOperator
  107           SComprehension _ -> SkArray
  108           SGuard -> SkBoolean
  109           SGen -> SkEvent
  110           SBody -> SkNamespace
  111           SGoal _ -> SkVariable
  112           SWhere -> SkObject
  113       )
  114 symbolKindFromDeclaration _ = Nothing