Decode.hs

module Server.Decode
  ( decodeChange
  , decodeRange
  , decodeLoc
  , decodeUri
  ) where

import Descript.Misc
import qualified Language.Haskell.LSP.Types as J
import qualified Data.Text as Text
import Network.URI

decodeChange :: (J.List J.TextDocumentContentChangeEvent) -> Change
-- LSP stores patches from bottom to top, Descript lib stores from top
-- to bottom. Maybe in the future should switch lib to bottom to top.
decodeChange (J.List xs)
  = foldMap liftCPatch <$> traverse decodeCChange (reverse xs)

decodeCChange :: J.TextDocumentContentChangeEvent -> CChange
decodeCChange (J.TextDocumentContentChangeEvent Nothing _ text)
  = Left text
decodeCChange (J.TextDocumentContentChangeEvent (Just range) _ text)
  = Right CPatch
  { cpatchRange = decodeRange range
  , cpatchText = text
  }

decodeRange :: J.Range -> Range
decodeRange (J.Range start' end')
  = Range
  { start = decodeLoc start'
  , end = decodeLoc end'
  }

decodeLoc :: J.Position -> Loc
decodeLoc (J.Position line' column')
  = Loc
  { line = mkPos $ succ line'
  , column = mkPos $ succ column'
  }

-- TODO Maybe should preserve other URI information, and use MonadThrow
-- instead of error for bad URIs (although both should be caught).
decodeUri :: J.Uri -> FilePath
decodeUri = uriPath . forceParseURI . Text.unpack . J.getUri

forceParseURI :: String -> URI
forceParseURI x
  = case parseURI x of
         Nothing -> error "Not a valid URI"
         Just res -> res