wip

src/Error/Hydrated.hs

@@ -27,10 +27,11 @@ import qualified Query
 import Rock
 import qualified Span
 import qualified System.Directory as Directory
+import qualified UTF16
 
 data Hydrated = Hydrated
   { filePath :: FilePath
-  , lineColumn :: !Span.LineColumn
+  , lineColumn :: !UTF16.LineColumns
   , lineText :: !Text
   , error :: !Error
   }
@@ -53,10 +54,10 @@ headingAndBody error =
       (filePath, maybeOldSpan) <- fetch $ Query.DefinitionPosition definitionKind name
       text <- fetch $ Query.FileText filePath
       let (lineColumn, _) =
-            Position.lineColumn (fromMaybe 0 maybeOldSpan) text
+            UTF16.lineColumn (fromMaybe 0 maybeOldSpan) text
       pure
         ( "Duplicate name:" <+> Doc.pretty name
-        , Doc.pretty name <+> "has already been defined at" <+> Doc.pretty (Span.LineColumns lineColumn lineColumn) <> "."
+        , Doc.pretty name <+> "has already been defined at" <+> Doc.pretty (UTF16.LineColumns lineColumn lineColumn) <> "."
         )
     Error.ImportNotFound _ import_ ->
       let prettyModule = Doc.pretty import_.module_
@@ -111,7 +112,7 @@ headingAndBody error =
           (filePath, maybeDefSpan) <- fetch $ Query.DefinitionPosition definitionKind definitionName
           text <- fetch $ Query.FileText filePath
           let (previousLineColumn, _) =
-                Span.lineColumn (Span.absoluteFrom (fromMaybe 0 maybeDefSpan) previousSpan) text
+                UTF16.lineColumns (Span.absoluteFrom (fromMaybe 0 maybeDefSpan) previousSpan) text
           pure
             ( "Duplicate name in let block:" <+> Doc.pretty name
             , Doc.pretty name <+> "has already been defined at" <+> Doc.pretty previousLineColumn <> "."
@@ -244,17 +245,17 @@ pretty h = do
       <> Doc.pretty h.lineColumn
       <> ":"
       <+> heading
-      <> line
-      <> line
-      <> body
-      <> line
-      <> line
-      <> spannedLine
+        <> line
+        <> line
+        <> body
+        <> line
+        <> line
+        <> spannedLine
   where
     spannedLine =
-      let Span.LineColumns
-            (Position.LineColumn startLineNumber startColumnNumber)
-            (Position.LineColumn endLineNumber endColumnNumber) = h.lineColumn
+      let UTF16.LineColumns
+            (UTF16.LineColumn startLineNumber startColumnNumber)
+            (UTF16.LineColumn endLineNumber endColumnNumber) = h.lineColumn
 
           lineNumberText =
             show (startLineNumber + 1)
@@ -266,7 +267,7 @@ pretty h = do
             | startLineNumber == endLineNumber =
                 (endColumnNumber - startColumnNumber, mempty)
             | otherwise =
-                (Text.lengthWord8 h.lineText - startColumnNumber, "...")
+                (UTF16.length h.lineText - startColumnNumber, "...")
        in Doc.pretty (Text.replicate (lineNumberTextLength + 1) " ")
             <> "| "
             <> line
@@ -276,7 +277,7 @@ pretty h = do
             <> line
             <> Doc.pretty (Text.replicate (lineNumberTextLength + 1) " ")
             <> "| "
-            <> Doc.pretty (Text.replicate startColumnNumber " " <> "^" <> Text.replicate (spanLength - 1) "~" <> spanEnding)
+            <> Doc.pretty (Text.replicate (UTF16.toInt startColumnNumber) " " <> "^" <> Text.replicate (UTF16.toInt spanLength - 1) "~" <> spanEnding)
 
 fromError :: Error -> Task Query Hydrated
 fromError err = do
@@ -306,9 +307,9 @@ fromError err = do
           Left Error.Parsing.EOF -> do
             let eofPos =
                   Position.Absolute $ Text.lengthWord8 text
-            Span.lineColumn (Span.Absolute eofPos eofPos) text
+            UTF16.lineColumns (Span.Absolute eofPos eofPos) text
           Right span ->
-            Span.lineColumn span text
+            UTF16.lineColumns span text
   pure
     Hydrated
       { filePath = filePath
@@ -322,7 +323,7 @@ fromError err = do
 lineNumber :: Hydrated -> Int
 lineNumber err = l
   where
-    Span.LineColumns (Position.LineColumn l _) _ = err.lineColumn
+    UTF16.LineColumns (UTF16.LineColumn l _) _ = err.lineColumn
 
 prettyPrettyableTerm :: (MonadFetch Query m) => Int -> Error.PrettyableTerm -> m (Doc ann)
 prettyPrettyableTerm prec (Error.PrettyableTerm moduleName_ names term) = do

src/LanguageServer.hs

@@ -36,16 +36,15 @@ import qualified LanguageServer.GoToDefinition as GoToDefinition
 import qualified LanguageServer.Hover as Hover
 import qualified LanguageServer.References as References
 import qualified Occurrences.Intervals
-import qualified Position
 import Prettyprinter (Doc)
 import qualified Prettyprinter as Doc
 import qualified Project
 import Protolude hiding (State, state)
 import Query (Query)
 import Rock (Task)
-import qualified Span
 import qualified System.Directory as Directory
 import qualified System.FSNotify as FSNotify
+import qualified UTF16
 
 run :: IO ()
 run = do
@@ -469,30 +468,30 @@ errorToDiagnostic err doc =
     , _data_ = Nothing
     }
 
-spanToLocation :: FilePath -> Span.LineColumn -> LSP.Location
+spanToLocation :: FilePath -> UTF16.LineColumns -> LSP.Location
 spanToLocation filePath span =
   LSP.Location
     { _uri = LSP.filePathToUri filePath
     , _range = spanToRange span
     }
 
-spanToRange :: Span.LineColumn -> LSP.Range
-spanToRange (Span.LineColumns start end) =
+spanToRange :: UTF16.LineColumns -> LSP.Range
+spanToRange (UTF16.LineColumns start end) =
   LSP.Range
     { _start = positionToPosition start
     , _end = positionToPosition end
     }
 
-positionToPosition :: Position.LineColumn -> LSP.Position
-positionToPosition (Position.LineColumn line column) =
+positionToPosition :: UTF16.LineColumn -> LSP.Position
+positionToPosition (UTF16.LineColumn line column) =
   LSP.Position
     { _line = fromIntegral line
-    , _character = fromIntegral column
+    , _character = fromIntegral $ UTF16.toInt column
     }
 
-positionFromPosition :: LSP.Position -> Position.LineColumn
+positionFromPosition :: LSP.Position -> UTF16.LineColumn
 positionFromPosition (LSP.Position line column) =
-  Position.LineColumn (fromIntegral line) (fromIntegral column)
+  UTF16.LineColumn (fromIntegral line) (UTF16.CodeUnits $ fromIntegral column)
 
 uriToFilePath :: LSP.Uri -> FilePath
 uriToFilePath =

src/LanguageServer/CodeLens.hs

@@ -19,8 +19,9 @@ import Rock
 import qualified Scope
 import qualified Span
 import qualified Surface.Syntax as Surface
+import qualified UTF16
 
-codeLens :: FilePath -> Task Query [(Span.LineColumn, Doc ann)]
+codeLens :: FilePath -> Task Query [(UTF16.LineColumns, Doc ann)]
 codeLens filePath =
   runM $ do
     (moduleName, _, defs) <- fetch $ Query.ParsedFile filePath

src/LanguageServer/Completion.hs

@@ -26,19 +26,20 @@ import Monad
 import Name (Name (Name))
 import qualified Name
 import Plicity
-import qualified Position
 import Prettyprinter ((<+>))
 import Protolude hiding (catch, evaluate, moduleName)
 import Query (Query)
 import qualified Query
 import qualified Query.Mapped as Mapped
 import Rock
 import qualified Scope
+import qualified UTF16
 import Var (Var)
 
-complete :: FilePath -> Position.LineColumn -> Task Query (Maybe [LSP.CompletionItem])
-complete filePath (Position.LineColumn line column) =
-  CursorAction.cursorAction filePath (Position.LineColumn line $ max 0 $ column - 1) \item _ ->
+complete :: FilePath -> UTF16.LineColumn -> Task Query (Maybe [LSP.CompletionItem])
+complete filePath (UTF16.LineColumn line column) =
+  -- TODO needs to work on code points, not code units
+  CursorAction.cursorAction filePath (UTF16.LineColumn line $ max 0 $ column - 1) \item _ ->
     case item of
       CursorAction.Import _ ->
         empty
@@ -72,9 +73,10 @@ complete filePath (Position.LineColumn line column) =
                 , _data_ = Nothing
                 }
 
-questionMark :: FilePath -> Position.LineColumn -> Task Query (Maybe [LSP.CompletionItem])
-questionMark filePath (Position.LineColumn line column) =
-  CursorAction.cursorAction filePath (Position.LineColumn line $ max 0 $ column - 1) \item _ ->
+questionMark :: FilePath -> UTF16.LineColumn -> Task Query (Maybe [LSP.CompletionItem])
+questionMark filePath (UTF16.LineColumn line column) =
+  -- TODO needs to work on code points, not code units
+  CursorAction.cursorAction filePath (UTF16.LineColumn line $ max 0 $ column - 1) \item _ ->
     case item of
       CursorAction.Import _ ->
         empty
@@ -140,12 +142,13 @@ questionMark filePath (Position.LineColumn line column) =
                                       { _start =
                                           LSP.Position
                                             { _line = fromIntegral line
-                                            , _character = fromIntegral $ column - 1
+                                            , -- TODO needs to work with code points
+                                              _character = fromIntegral $ UTF16.toInt $ column - 1
                                             }
                                       , _end =
                                           LSP.Position
                                             { _line = fromIntegral line
-                                            , _character = fromIntegral column
+                                            , _character = fromIntegral $ UTF16.toInt column
                                             }
                                       }
                                 , _newText =

src/LanguageServer/CursorAction.hs

@@ -46,9 +46,10 @@ import qualified Scope
 import qualified Span
 import Telescope (Telescope)
 import qualified Telescope
+import qualified UTF16
 import Var (Var)
 
-type Callback a = ItemUnderCursor -> Span.LineColumn -> MaybeT M a
+type Callback a = ItemUnderCursor -> UTF16.LineColumns -> MaybeT M a
 
 data ItemUnderCursor where
   Term
@@ -70,22 +71,20 @@ data ItemContext
 cursorAction
   :: forall a
    . FilePath
-  -> Position.LineColumn
+  -> UTF16.LineColumn
   -> Callback a
   -> Task Query (Maybe a)
-cursorAction filePath (Position.LineColumn line column) k =
+cursorAction filePath (UTF16.LineColumn line column) k =
   runM $
     runMaybeT $ do
       (moduleName, moduleHeader, _) <- fetch $ Query.ParsedFile filePath
       spans <- fetch $ Query.ModuleSpanMap moduleName
-      contents <- fetch $ Query.FileText filePath
-      let
-        -- TODO use the rope that we get from the LSP library instead
-        pos =
-          Position.Absolute $
-            case Rope.splitAtPosition (Rope.Position (fromIntegral line) (fromIntegral column)) $ Rope.fromText contents of
-              Nothing -> 0
-              Just (rope, _) -> fromIntegral $ Rope.length rope
+      contents <- fetch $ Query.FileRope filePath
+      let pos =
+            Position.Absolute $
+              case Rope.splitAtPosition (Rope.Position (fromIntegral line) (fromIntegral $ UTF16.toInt column)) contents of
+                Nothing -> 0
+                Just (rope, _) -> fromIntegral $ Rope.utf8Length rope
 
       toLineColumns <- LineColumns.fromAbsolute moduleName
       asum $

src/LanguageServer/DocumentHighlights.hs

@@ -14,22 +14,21 @@ import Query (Query)
 import qualified Query
 import Rock
 import qualified Span
+import qualified UTF16
 
 highlights
   :: FilePath
-  -> Position.LineColumn
-  -> Task Query [Span.LineColumn]
-highlights filePath (Position.LineColumn line column) = do
+  -> UTF16.LineColumn
+  -> Task Query [UTF16.LineColumns]
+highlights filePath (UTF16.LineColumn line column) = do
   (moduleName, _, _) <- fetch $ Query.ParsedFile filePath
   spans <- fetch $ Query.ModuleSpanMap moduleName
-  contents <- fetch $ Query.FileText filePath
-  let
-    -- TODO use the rope that we get from the LSP library instead
-    pos =
-      Position.Absolute $
-        case Rope.splitAtPosition (Rope.Position (fromIntegral line) (fromIntegral column)) $ Rope.fromText contents of
-          Nothing -> 0
-          Just (rope, _) -> fromIntegral $ Rope.length rope
+  contents <- fetch $ Query.FileRope filePath
+  let pos =
+        Position.Absolute $
+          case Rope.splitAtPosition (Rope.Position (fromIntegral line) (fromIntegral $ UTF16.toInt column)) contents of
+            Nothing -> 0
+            Just (rope, _) -> fromIntegral $ Rope.utf8Length rope
 
   toLineColumns <- LineColumns.fromAbsolute moduleName
 

src/LanguageServer/GoToDefinition.hs

@@ -20,17 +20,18 @@ import qualified Query
 import Rock
 import qualified Scope
 import qualified Span
+import qualified UTF16
 
-goToDefinition :: FilePath -> Position.LineColumn -> Task Query (Maybe (FilePath, Span.LineColumn))
-goToDefinition filePath (Position.LineColumn line column) = do
+goToDefinition :: FilePath -> UTF16.LineColumn -> Task Query (Maybe (FilePath, UTF16.LineColumns))
+goToDefinition filePath (UTF16.LineColumn line column) = do
   (moduleName, moduleHeader, _) <- fetch $ Query.ParsedFile filePath
   spans <- fetch $ Query.ModuleSpanMap moduleName
   rope <- fetch $ Query.FileRope filePath
   let pos =
         Position.Absolute $
-          case Rope.splitAtPosition (Rope.Position (fromIntegral line) (fromIntegral column)) rope of
+          case Rope.splitAtPosition (Rope.Position (fromIntegral line) (fromIntegral $ UTF16.toInt column)) rope of
             Nothing -> 0
-            Just (rope', _) -> fromIntegral $ Rope.length rope'
+            Just (rope', _) -> fromIntegral $ Rope.utf8Length rope'
 
   runMaybeT $
     asum $
@@ -44,7 +45,7 @@ goToDefinition filePath (Position.LineColumn line column) = do
               Nothing ->
                 empty
               Just definingFile ->
-                pure (definingFile, Span.LineColumns (Position.LineColumn 0 0) (Position.LineColumn 0 0))
+                pure (definingFile, UTF16.LineColumns (UTF16.LineColumn 0 0) (UTF16.LineColumn 0 0))
         )
         <> foreach
           (HashMap.toList spans)

src/LanguageServer/Hover.hs

@@ -9,14 +9,13 @@ import qualified Elaboration
 import qualified Elaboration.Context as Context
 import qualified Error.Hydrated as Error
 import qualified LanguageServer.CursorAction as CursorAction
-import qualified Position
 import Prettyprinter (Doc, (<+>))
 import Protolude hiding (evaluate, moduleName)
 import Query (Query)
 import Rock
-import qualified Span
+import qualified UTF16
 
-hover :: FilePath -> Position.LineColumn -> Task Query (Maybe (Span.LineColumn, Doc ann))
+hover :: FilePath -> UTF16.LineColumn -> Task Query (Maybe (UTF16.LineColumns, Doc ann))
 hover filePath pos =
   CursorAction.cursorAction filePath pos \item lineColumn ->
     case item of

src/LanguageServer/LineColumns.hs

@@ -10,31 +10,31 @@ import Query (Query)
 import qualified Query
 import Rock
 import qualified Scope
-import Span (LineColumn (LineColumns))
 import qualified Span
+import UTF16
 
-fromDefinitionName :: (MonadFetch Query m) => Scope.DefinitionKind -> Name.Qualified -> m (Maybe (Span.Relative -> Span.LineColumn))
+fromDefinitionName :: (MonadFetch Query m) => Scope.DefinitionKind -> Name.Qualified -> m (Maybe (Span.Relative -> UTF16.LineColumns))
 fromDefinitionName definitionKind name@(Name.Qualified moduleName _) = do
   (_, maybeAbsolutePosition) <- fetch $ Query.DefinitionPosition definitionKind name
   toLineColumns <- fromAbsolute moduleName
   pure $ fmap ((toLineColumns .) . Span.absoluteFrom) maybeAbsolutePosition
 
-fromAbsolute :: (MonadFetch Query m) => Name.Module -> m (Span.Absolute -> Span.LineColumn)
+fromAbsolute :: (MonadFetch Query m) => Name.Module -> m (Span.Absolute -> UTF16.LineColumns)
 fromAbsolute moduleName = do
   maybeFilePath <- fetch $ Query.ModuleFile moduleName
   case maybeFilePath of
     Nothing ->
-      pure $ const $ Span.LineColumns (Position.LineColumn 0 0) (Position.LineColumn 0 0)
+      pure $ const $ UTF16.LineColumns (UTF16.LineColumn 0 0) (UTF16.LineColumn 0 0)
     Just filePath -> do
       rope <- fetch $ Query.FileRope filePath
       let toLineColumn (Position.Absolute i) =
             case Rope.splitAt (fromIntegral i) rope of
-              Nothing -> Position.LineColumn 0 0
+              Nothing -> UTF16.LineColumn 0 0
               Just (rope', _) ->
                 let Rope.Position row column = Rope.lengthAsPosition rope'
-                 in Position.LineColumn (fromIntegral row) (fromIntegral column)
+                 in UTF16.LineColumn (fromIntegral row) (fromIntegral column)
 
           toLineColumns (Span.Absolute start end) =
-            Span.LineColumns (toLineColumn start) (toLineColumn end)
+            UTF16.LineColumns (toLineColumn start) (toLineColumn end)
 
       return toLineColumns