Merge pull request #73 from fwcd/record-dot-part-2

Migrate remaining types to record dot syntax

src/Curry/LanguageServer/Handlers/TextDocument/Completion.hs

@@ -92,7 +92,7 @@ pragmaCompletions opts query
 
 importCompletions :: (MonadIO m, MonadLsp CFG.Config m) => CompletionOptions -> I.IndexStore -> VFS.PosPrefixInfo -> m [J.CompletionItem]
 importCompletions opts store query = do
-    let modules            = nubOrdOn I.sQualIdent $ I.storedModuleSymbolsWithPrefix (fullPrefix query) store
+    let modules            = nubOrdOn (.qualIdent) $ I.storedModuleSymbolsWithPrefix (fullPrefix query) store
         moduleCompletions  = toMatchingCompletions opts query $ (\s -> CompletionSymbol s Nothing Nothing) <$> modules
         keywordCompletions = toMatchingCompletions opts query $ Keyword <$> ["qualified", "as", "hiding"]
         completions        = moduleCompletions ++ keywordCompletions
@@ -104,8 +104,8 @@ generalCompletions opts entry store query = do
     let localIdentifiers   = join <$> maybe M.empty (`findScopeAtPos` VFS.cursorPos query) entry.moduleAST
         localIdentifiers'  = M.fromList $ map (first ppToText) $ M.toList localIdentifiers
         localCompletions   = toMatchingCompletions opts query $ uncurry Local <$> M.toList localIdentifiers'
-        symbols            = filter (flip M.notMember localIdentifiers' . I.sIdent) $ nubOrdOn I.sQualIdent
-                                                                                   $ I.storedSymbolsWithPrefix (VFS.prefixText query) store
+        symbols            = filter (flip M.notMember localIdentifiers' . (.ident)) $ nubOrdOn (.qualIdent)
+                                                                                    $ I.storedSymbolsWithPrefix (VFS.prefixText query) store
         symbolCompletions  = toMatchingCompletions opts query $ toCompletionSymbols entry =<< symbols
         keywordCompletions = toMatchingCompletions opts query keywords
         completions        = localCompletions ++ symbolCompletions ++ keywordCompletions
@@ -143,21 +143,21 @@ toCompletionSymbols entry s = do
     let pre = "Prelude"
         impNames = S.fromList [ppToText mid' | CS.ImportDecl _ mid' _ _ _ <- imps]
 
-    if | I.sKind s == I.Module -> return CompletionSymbol
+    if | s.kind == I.Module -> return CompletionSymbol
             { symbol = s
             , moduleName = Nothing
             , importEdits = Nothing
             }
-       | (I.sParentIdent s == pre && pre `S.notMember` impNames) || I.sParentIdent s == ppToText mid -> do
-            m <- [Nothing, Just $ I.sParentIdent s]
+       | (I.symbolParentIdent s == pre && pre `S.notMember` impNames) || I.symbolParentIdent s == ppToText mid -> do
+            m <- [Nothing, Just $ I.symbolParentIdent s]
             return CompletionSymbol
                 { symbol = s
                 , moduleName = m
                 , importEdits = Nothing
                 }
        | otherwise -> do
             CS.ImportDecl _ mid' isQual alias spec <- imps
-            guard $ ppToText mid' == I.sParentIdent s
+            guard $ ppToText mid' == I.symbolParentIdent s
 
             let isImported = case spec of
                     Just (CS.Importing _ is) -> flip S.member $ S.fromList $ ppToText <$> (identifiers =<< is)
@@ -169,14 +169,14 @@ toCompletionSymbols entry s = do
             return CompletionSymbol
                 { symbol = s
                 , moduleName = m
-                , importEdits = if isImported $ I.sIdent s
+                , importEdits = if isImported s.ident
                     then Nothing
                     else case spec of
                         Just (CS.Importing _ is) -> do
                             J.Range _ pos <- currySpanInfo2Range =<< lastSafe is
                             let range = J.Range pos pos
-                                text | null is   = I.sIdent s
-                                     | otherwise = ", " <> I.sIdent s
+                                text | null is   = s.ident
+                                     | otherwise = ", " <> s.ident
                                 edit = J.TextEdit range text
                             return [edit]
                         _                        -> return []
@@ -185,8 +185,8 @@ toCompletionSymbols entry s = do
 
 -- | The fully qualified, possibly aliased, name of the completion symbol.
 fullName :: CompletionSymbol -> T.Text
-fullName cms | I.sKind s == I.Module = I.sQualIdent s
-             | otherwise             = maybe "" (<> ".") moduleName <> I.sIdent s
+fullName cms | s.kind == I.Module = s.qualIdent
+             | otherwise          = maybe "" (<> ".") moduleName <> s.ident
     where s = cms.symbol
           moduleName = cms.moduleName
 
@@ -222,27 +222,27 @@ instance ToCompletionItems CompletionSymbol where
         where s = cms.symbol
               edits = cms.importEdits
               name = fromMaybe (fullName cms) $ T.stripPrefix (VFS.prefixModule query <> ".") $ fullName cms
-              ciKind = case I.sKind s of
-                  I.ValueFunction    | I.sArrowArity s == Just 0 -> J.CiConstant
-                                     | otherwise                 -> J.CiFunction
-                  I.ValueConstructor | I.sArrowArity s == Just 0 -> J.CiEnumMember
-                                     | otherwise                 -> J.CiConstructor
-                  I.Module                                       -> J.CiModule
-                  I.TypeData | length (I.sConstructors s) == 1   -> J.CiStruct
-                             | otherwise                         -> J.CiEnum
-                  I.TypeNew                                      -> J.CiStruct
-                  I.TypeAlias                                    -> J.CiInterface
-                  I.TypeClass                                    -> J.CiInterface
-                  I.TypeVar                                      -> J.CiVariable
-                  I.Other                                        -> J.CiText
-              insertText | opts.useSnippets = Just $ makeSnippet name $ I.sPrintedArgumentTypes s
+              ciKind = case s.kind of
+                  I.ValueFunction    | s.arrowArity == Just 0 -> J.CiConstant
+                                     | otherwise              -> J.CiFunction
+                  I.ValueConstructor | s.arrowArity == Just 0 -> J.CiEnumMember
+                                     | otherwise              -> J.CiConstructor
+                  I.Module                                    -> J.CiModule
+                  I.TypeData | length s.constructors == 1   -> J.CiStruct
+                             | otherwise                    -> J.CiEnum
+                  I.TypeNew                                 -> J.CiStruct
+                  I.TypeAlias                               -> J.CiInterface
+                  I.TypeClass                               -> J.CiInterface
+                  I.TypeVar                                 -> J.CiVariable
+                  I.Other                                   -> J.CiText
+              insertText | opts.useSnippets = Just $ makeSnippet name s.printedArgumentTypes
                          | otherwise        = Just name
               insertTextFormat | opts.useSnippets = Just J.Snippet
                                | otherwise        = Just J.PlainText
-              detail = I.sPrintedType s
+              detail = s.printedType
               doc = Just $ T.intercalate "\n\n" $ filter (not . T.null)
                   [ if isNothing edits then "" else "_requires import_"
-                  , T.intercalate ", " $ I.sConstructors s
+                  , T.intercalate ", " s.constructors
                   ]
 
 instance ToCompletionItems Keyword where

src/Curry/LanguageServer/Handlers/TextDocument/Definition.hs

@@ -47,5 +47,5 @@ definitions :: MonadIO m => I.IndexStore -> ModuleAST -> J.Position -> MaybeT m
 definitions store ast pos = do
     -- Look up identifier under cursor
     (symbols, srcRange) <- liftMaybe $ resolveAtPos store ast pos
-    let locations = mapMaybe I.sLocation symbols
+    let locations = mapMaybe (.location) symbols
     return [J.LocationLink (Just srcRange) destUri destRange destRange | J.Location destUri destRange <- locations]

src/Curry/LanguageServer/Handlers/TextDocument/Hover.hs

@@ -51,7 +51,7 @@ qualIdentHover store ast pos = do
     (symbols, range) <- resolveAtPos store ast pos
     s <- listToMaybe symbols
 
-    let contents = J.HoverContents $ J.markedUpContent "curry" $ I.sQualIdent s <> maybe "" (" :: " <>) (I.sPrintedType s)
+    let contents = J.HoverContents $ J.markedUpContent "curry" $ s.qualIdent <> maybe "" (" :: " <>) s.printedType
 
     return $ J.Hover contents $ Just range
 

src/Curry/LanguageServer/Handlers/TextDocument/SignatureHelp.hs

@@ -60,18 +60,18 @@ fetchSignatureHelp store entry vfile pos@(J.Position l c) = runMaybeT $ do
     (sym, spi, args) <- liftMaybe
         $  findExpressionApplication store ast pos'
        <|> findTypeApplication       store ast pos'
-    lift $ infoM $ "Found symbol " <> I.sQualIdent sym
+    lift $ infoM $ "Found symbol " <> sym.qualIdent
     symEnd <- liftMaybe [end | J.Range _ end <- currySpanInfo2Range spi]
     let defaultParam | pos >= symEnd = fromIntegral $ length args
                      | otherwise     = 0
         activeParam = maybe defaultParam fst $ find (elementContains pos . snd) (zip [0..] args)
         activeSig = 0
-        labelStart = I.sQualIdent sym <> " :: "
+        labelStart = sym.qualIdent <> " :: "
         paramSep = " -> "
-        paramLabels = I.sPrintedArgumentTypes sym
+        paramLabels = sym.printedArgumentTypes
         paramOffsets = reverse $ snd $ foldl (\(n, offs) lbl -> let n' = n + T.length lbl in (n' + T.length paramSep, (n, n') : offs)) (T.length labelStart, []) paramLabels
         params = flip J.ParameterInformation Nothing . uncurry J.ParameterLabelOffset . bimap fromIntegral fromIntegral <$> paramOffsets
-        label = labelStart <> T.intercalate paramSep (paramLabels ++ maybeToList (I.sPrintedResultType sym))
+        label = labelStart <> T.intercalate paramSep (paramLabels ++ maybeToList sym.printedResultType)
         sig = J.SignatureInformation label Nothing (Just $ J.List params) (Just activeParam)
         sigs = [sig]
     return $ J.SignatureHelp (J.List sigs) (Just activeSig) (Just activeParam)

src/Curry/LanguageServer/Handlers/Workspace/Symbol.hs

@@ -1,4 +1,4 @@
-{-# LANGUAGE OverloadedStrings, FlexibleContexts #-}
+{-# LANGUAGE NoFieldSelectors, OverloadedStrings, OverloadedRecordDot, FlexibleContexts #-}
 module Curry.LanguageServer.Handlers.Workspace.Symbol (workspaceSymbolHandler) where
 
 import Control.Lens ((^.))
@@ -32,21 +32,21 @@ fetchWorkspaceSymbols store query = do
     return symbols
 
 toWorkspaceSymbol :: I.Symbol -> Maybe J.SymbolInformation
-toWorkspaceSymbol s = (\loc -> J.SymbolInformation name kind tags deprecated loc containerName) <$> I.sLocation s
-    where name = I.sIdent s
-          kind = case I.sKind s of
-              I.ValueFunction    | I.sArrowArity s == Just 0 -> J.SkConstant
-                                 | otherwise                 -> J.SkFunction
-              I.ValueConstructor | I.sArrowArity s == Just 0 -> J.SkEnumMember
-                                 | otherwise                 -> J.SkConstructor
-              I.Module                                       -> J.SkModule
-              I.TypeData | length (I.sConstructors s) == 1   -> J.SkStruct
-                         | otherwise                         -> J.SkEnum
-              I.TypeNew                                      -> J.SkStruct
-              I.TypeAlias                                    -> J.SkInterface
-              I.TypeClass                                    -> J.SkInterface
-              I.TypeVar                                      -> J.SkVariable
-              I.Other                                        -> J.SkNamespace
+toWorkspaceSymbol s = (\loc -> J.SymbolInformation name kind tags deprecated loc containerName) <$> s.location
+    where name = s.ident
+          kind = case s.kind of
+              I.ValueFunction    | s.arrowArity == Just 0 -> J.SkConstant
+                                 | otherwise              -> J.SkFunction
+              I.ValueConstructor | s.arrowArity == Just 0 -> J.SkEnumMember
+                                 | otherwise              -> J.SkConstructor
+              I.Module                                    -> J.SkModule
+              I.TypeData | length s.constructors == 1     -> J.SkStruct
+                         | otherwise                      -> J.SkEnum
+              I.TypeNew                                   -> J.SkStruct
+              I.TypeAlias                                 -> J.SkInterface
+              I.TypeClass                                 -> J.SkInterface
+              I.TypeVar                                   -> J.SkVariable
+              I.Other                                     -> J.SkNamespace
           tags = Nothing
           deprecated = Nothing
-          containerName = Just $ I.sParentIdent s
+          containerName = Just $ I.symbolParentIdent s

src/Curry/LanguageServer/Index/Convert.hs

@@ -30,7 +30,7 @@ class ToSymbols s where
 instance ToSymbols (CI.QualIdent, CEV.ValueInfo) where
     toSymbols (q, vinfo)
         | CI.isQualified q' = pure <$> case vinfo of
-            CEV.DataConstructor _ _ ls t  -> (\s -> s { sConstructors = ppToText <$> ls })
+            CEV.DataConstructor _ _ ls t  -> (\s -> s { constructors = ppToText <$> ls })
                                         <$> makeValueSymbol ValueConstructor q' t
             CEV.NewtypeConstructor _ _ t  -> makeValueSymbol ValueConstructor q' t
             CEV.Value _ _ _ t             -> makeValueSymbol ValueFunction q' t
@@ -55,10 +55,10 @@ instance ToSymbols CI.ModuleIdent where
         return $ do
             quals <- tail $ inits $ T.pack <$> CI.midQualifiers mid
             return def
-                { sKind = Module
-                , sQualIdent = T.intercalate "." quals
-                , sIdent = fromMaybe "" $ lastSafe quals
-                , sLocation = loc
+                { kind = Module
+                , qualIdent = T.intercalate "." quals
+                , ident = fromMaybe "" $ lastSafe quals
+                , location = loc
                 }
 
 qualifyWithModuleFrom :: CTE.Entity a => a -> CI.QualIdent -> CI.QualIdent
@@ -68,32 +68,32 @@ makeValueSymbol :: MonadIO m => SymbolKind -> CI.QualIdent -> CT.TypeScheme -> m
 makeValueSymbol k q t = do
     loc <- runMaybeT $ currySpanInfo2Location $ CI.qidIdent q
     return def
-        { sKind = k
-        , sQualIdent = ppToText q
-        , sIdent = ppToText $ CI.qidIdent q
-        , sPrintedType = Just $ ppToText t
+        { kind = k
+        , qualIdent = ppToText q
+        , ident = ppToText $ CI.qidIdent q
+        , printedType = Just $ ppToText t
         -- We explicitly perform the Type -> TypeExpr conversion here since
         -- the Pretty Type instance ignores the precedence.
-        , sPrintedArgumentTypes = ppToTextPrec 2 . CTS.fromType CI.identSupply <$> CT.arrowArgs (CT.rawType t)
-        , sPrintedResultType = Just $ ppToText $ CT.arrowBase (CT.rawType t)
-        , sArrowArity = Just $ CT.arrowArity $ CT.rawType t
-        , sLocation = loc
+        , printedArgumentTypes = ppToTextPrec 2 . CTS.fromType CI.identSupply <$> CT.arrowArgs (CT.rawType t)
+        , printedResultType = Just $ ppToText $ CT.arrowBase (CT.rawType t)
+        , arrowArity = Just $ CT.arrowArity $ CT.rawType t
+        , location = loc
         }
 
 makeTypeSymbol :: MonadIO m => SymbolKind -> CI.QualIdent -> CK.Kind -> m Symbol
 makeTypeSymbol k q k' = do
     loc <- runMaybeT $ currySpanInfo2Location $ CI.qidIdent q
     return def
-        { sKind = k
-        , sQualIdent = ppToText q
-        , sIdent = ppToText $ CI.qidIdent q
-        , sPrintedType = Just $ ppToText k'
+        { kind = k
+        , qualIdent = ppToText q
+        , ident = ppToText $ CI.qidIdent q
+        , printedType = Just $ ppToText k'
         -- We explicitly perform the Kind conversion here since
         -- the Pretty Kind instance ignores the precedence.
-        , sPrintedArgumentTypes = ppToTextPrec 2 . CKS.fromKind <$> CK.kindArgs k'
-        , sPrintedResultType = Just $ ppToText $ kindBase k'
-        , sArrowArity = Just $ CK.kindArity k'
-        , sLocation = loc
+        , printedArgumentTypes = ppToTextPrec 2 . CKS.fromKind <$> CK.kindArgs k'
+        , printedResultType = Just $ ppToText $ kindBase k'
+        , arrowArity = Just $ CK.kindArity k'
+        , location = loc
         }
     where kindBase (CK.KindArrow _ k'') = kindBase k''
           kindBase k''                  = k''

src/Curry/LanguageServer/Index/Resolve.hs

@@ -51,5 +51,5 @@ resolveModuleIdent store mid = tryFilterFromCurrySource $ I.storedModuleSymbolsB
 
 -- | Tries filtering symbols from a Curry source file.
 tryFilterFromCurrySource :: [I.Symbol] -> [I.Symbol]
-tryFilterFromCurrySource symbols | any I.sIsFromCurrySource symbols = filter I.sIsFromCurrySource symbols
-                                 | otherwise                        = symbols
+tryFilterFromCurrySource symbols | any I.symbolIsFromCurrySource symbols = filter I.symbolIsFromCurrySource symbols
+                                 | otherwise                             = symbols

src/Curry/LanguageServer/Index/Store.hs

@@ -138,7 +138,7 @@ storedSymbolsWithPrefix pre = join . TR.elems . TR.submap (TE.encodeUtf8 pre) .
 
 -- | Fetches stored symbols by qualified identifier.
 storedSymbolsByQualIdent :: CI.QualIdent -> IndexStore -> [Symbol]
-storedSymbolsByQualIdent q = filter ((== ppToText q) . sQualIdent) . storedSymbolsByKey name
+storedSymbolsByQualIdent q = filter ((== ppToText q) . (.qualIdent)) . storedSymbolsByKey name
     where name = T.pack $ CI.idName $ CI.qidIdent q
 
 -- | Fetches the given (qualified) module symbol names in the store.
@@ -241,22 +241,22 @@ walkCurrySourceFiles = (filter ((== ".curry") . takeExtension) <$>) . walkIgnori
 --         to aggregate the state across recursive calls, perhaps by requiring a Monoid instance?)
 walkIgnoringHidden :: (MonadIO m, MonadLsp CFG.Config m) => FilePath -> m [FilePath]
 walkIgnoringHidden = walkFilesWith WalkConfiguration
-    { wcOnEnter            = \fp -> do
+    { onEnter            = \fp -> do
         ignorePaths <- filterM (liftIO . doesFileExist) $ (fp </>) <$> [".curry-language-server-ignore", ".gitignore"]
         ignored     <- join <$> mapM readIgnoreFile ignorePaths
         unless (null ignored) $
             infoM $ "In '" <> T.pack (takeFileName fp) <> "' ignoring " <> T.pack (show (G.decompile <$> ignored))
         return $ Just ignored
-    , wcShouldIgnore       = \ignored fp -> do
+    , shouldIgnore       = \ignored fp -> do
         isDir <- liftIO $ doesDirectoryExist fp
         let fn              = takeFileName fp
             matchesFn pat   = any (G.match pat) $ catMaybes [Just fn, if isDir then Just (fn ++ "/") else Nothing]
             matchingIgnores = filter matchesFn ignored
         unless (null matchingIgnores) $
             debugM $ "Ignoring '" <> T.pack fn <> "' since it matches " <> T.pack (show (G.decompile <$> matchingIgnores))
         return $ not (null matchingIgnores) || "." `isPrefixOf` fn
-    , wcIncludeDirectories = True
-    , wcIncludeFiles       = True
+    , includeDirectories = True
+    , includeFiles       = True
     }
 
 -- | Reads the given ignore file, fetching the ignored (relative) paths.
@@ -314,10 +314,10 @@ recompileFile i total cfg fl importPaths dirPath filePath = void $ do
         modSymbols   <- toSymbols (moduleIdentifier ast)
 
         let symbolDelta = valueSymbols ++ typeSymbols ++ modSymbols
-            combiner = unionBy ((==) `on` (\s' -> (sKind s', sQualIdent s', sIsFromCurrySource s')))
+            combiner = unionBy ((==) `on` (\s' -> (s'.kind, s'.qualIdent, symbolIsFromCurrySource s')))
         modify $ \s -> s
-            { symbols = insertAllIntoTrieWith combiner ((\s' -> (TE.encodeUtf8 $ sIdent s', [s'])) <$> symbolDelta) s.symbols
-            , moduleSymbols = insertAllIntoTrieWith (unionBy ((==) `on` sQualIdent)) ((\s' -> (TE.encodeUtf8 $ sQualIdent s', [s'])) <$> modSymbols) s.moduleSymbols
+            { symbols = insertAllIntoTrieWith combiner ((\s' -> (TE.encodeUtf8 s'.ident, [s'])) <$> symbolDelta) s.symbols
+            , moduleSymbols = insertAllIntoTrieWith (unionBy ((==) `on` (.qualIdent))) ((\s' -> (TE.encodeUtf8 s'.qualIdent, [s'])) <$> modSymbols) s.moduleSymbols
             }
 
     -- Update store with messages from files that were not successfully compiled