never executed always true always false

    1 module Conjure.LSP.Documentation where
    2 
    3 import Conjure.Language.Validator (DocType (..), RegionType (Documentation))
    4 import Conjure.Prelude
    5 import Data.ByteString.Lazy qualified as BL
    6 import Data.Text qualified as T
    7 import Data.Text.Encoding (decodeUtf8)
    8 import Language.LSP.Protocol.Types (MarkupContent (..), MarkupKind (..))
    9 import Network.HTTP.Client
   10 import Network.HTTP.Client.TLS
   11 
   12 getDocsForBuiltin :: RegionType -> IO (Maybe MarkupContent)
   13 getDocsForBuiltin (Documentation prefix (T.unpack -> name)) = do
   14   let category = case prefix of
   15         OperatorD -> "operator"
   16         FunctionD -> "function"
   17         KeywordD -> "keyword"
   18         TypeD -> "type"
   19         AttributeD -> "attribute"
   20 
   21       download = do
   22         -- create a connection manager
   23         manager <- newManager tlsManagerSettings
   24         -- create the request
   25         request <- parseRequest (readUrl category name)
   26         -- make the request
   27         r <- httpLbs request manager
   28         -- get the contents (as a lazy ByteString)
   29         let contents = decodeUtf8 $ BL.toStrict $ responseBody r
   30         if contents == "404: Not Found"
   31           then return $ Just $ fallbackMsg category name
   32           else
   33             return
   34               $ Just
   35               $ MarkupContent MarkupKind_Markdown
   36               $ T.concat
   37                 [ contents,
   38                   "\n\n -- \n\n",
   39                   "[Edit this doc](",
   40                   editURL category name,
   41                   ")"
   42                 ]
   43 
   44       handler :: HttpException -> IO (Maybe MarkupContent)
   45       handler _ = return $ Just $ MarkupContent MarkupKind_Markdown "No internet connection"
   46 
   47   download `catch` handler
   48 getDocsForBuiltin _ = pure Nothing
   49 
   50 fallbackMsg :: String -> String -> MarkupContent
   51 fallbackMsg c n = MarkupContent MarkupKind_Markdown $ T.concat ["[Create this doc](", createURL c n, ")"]
   52 
   53 branch :: String
   54 branch = "main"
   55 
   56 readUrl :: String -> String -> String
   57 readUrl category name =
   58   concat
   59     [ "https://raw.githubusercontent.com/conjure-cp/conjure/" ++ branch ++ "/docs/bits/",
   60       category,
   61       "/",
   62       name,
   63       ".md"
   64     ]
   65 
   66 createURL :: String -> String -> Text
   67 createURL category name =
   68   T.pack
   69     $ concat
   70       [ "https://github.com/conjure-cp/conjure/new/" ++ branch ++ "/docs/bits/",
   71         category,
   72         "?filename=",
   73         name,
   74         ".md"
   75       ]
   76 
   77 editURL :: String -> String -> Text
   78 editURL category name =
   79   T.pack
   80     $ concat
   81       [ "https://github.com/conjure-cp/conjure/edit/" ++ branch ++ "/docs/bits/",
   82         category,
   83         "/",
   84         name,
   85         ".md"
   86       ]