Migrate to record dot syntax

src/Curry/LanguageServer/Compiler.hs

@@ -1,4 +1,4 @@
-{-# LANGUAGE LambdaCase, OverloadedStrings, FlexibleContexts #-}
+{-# LANGUAGE LambdaCase, NoFieldSelectors, OverloadedStrings, OverloadedRecordDot, FlexibleContexts #-}
 module Curry.LanguageServer.Compiler
     ( CompileAuxiliary (..)
     , CompileState (..)
@@ -63,20 +63,20 @@ newtype CompileAuxiliary = CompileAuxiliary
 
 -- | Read/write state used during compilation.
 data CompileState = CompileState
-    { csWarnings :: [CM.Message]
-    , csErrors :: [CM.Message]
+    { warnings :: [CM.Message]
+    , errors :: [CM.Message]
     }
 
 instance Semigroup CompileState where
     x <> y = CompileState
-        { csWarnings = csWarnings x ++ csWarnings y
-        , csErrors = csErrors x ++ csErrors y
+        { warnings = x.warnings ++ y.warnings
+        , errors = x.errors ++ y.errors
         }
 
 instance Monoid CompileState where
     mempty = CompileState
-        { csWarnings = []
-        , csErrors = []
+        { warnings = []
+        , errors = []
         }
 
 -- | A custom monad for compilation state as a CYIO-replacement that doesn't track errors in an ExceptT.
@@ -88,10 +88,10 @@ runCMT cm aux = flip runReaderT aux . flip runStateT mempty . runMaybeT $ cm
 catchCYIO :: MonadIO m => CYIO a -> CMT m (Maybe a)
 catchCYIO cyio = liftIO (runCYIO cyio) >>= \case
     Left es       -> do
-        modify $ \s -> s { csErrors = csErrors s ++ es }
+        modify $ \s -> s { errors = s.errors ++ es }
         return Nothing
     Right (x, ws) -> do
-        modify $ \s -> s { csWarnings = csWarnings s ++ ws }
+        modify $ \s -> s { warnings = s.warnings ++ ws }
         return $ Just x
 
 liftToCM :: Monad m => m a -> CMT m a
@@ -113,9 +113,9 @@ compileCurryFileWithDeps cfg aux importPaths outDirPath filePath = (fromMaybe me
     let defOpts = CO.defaultOptions
         cppOpts = CO.optCppOpts defOpts
         cppDefs = M.insert "__PAKCS__" 300 (CO.cppDefinitions cppOpts)
-        opts = CO.defaultOptions { CO.optForce = CFG.cfgForceRecompilation cfg
-                                 , CO.optImportPaths = importPaths ++ CFG.cfgImportPaths cfg
-                                 , CO.optLibraryPaths = CFG.cfgLibraryPaths cfg
+        opts = CO.defaultOptions { CO.optForce = cfg.forceRecompilation
+                                 , CO.optImportPaths = importPaths ++ cfg.importPaths
+                                 , CO.optLibraryPaths = cfg.libraryPaths
                                  , CO.optCppOpts = cppOpts { CO.cppDefinitions = cppDefs }
                                  , CO.optExtensions = nub $ CSE.kielExtensions ++ CO.optExtensions defOpts
                                  , CO.optOriginPragmas = True
@@ -170,7 +170,7 @@ compileCurryModule opts outDirPath m fp = do
 loadAndCheckCurryModule :: MonadIO m => CO.Options -> CI.ModuleIdent -> FilePath -> CMT m (CE.CompEnv ModuleAST)
 loadAndCheckCurryModule opts m fp = do
     -- Read source file (possibly from VFS)
-    fl <- asks fileLoader
+    fl <- asks (.fileLoader)
     src <- liftIO $ fl fp
     -- Load and check module
     loaded <- liftCYIO $ loadCurryModule opts m src fp
@@ -231,7 +231,7 @@ parseCurryModule opts _ src fp = do
     return (lexed, ast)
 
 failedCompilation :: String -> (CompileOutput, CompileState)
-failedCompilation msg = (mempty, mempty { csErrors = [makeFailMessage msg] })
+failedCompilation msg = (mempty, mempty { errors = [makeFailMessage msg] })
 
 makeFailMessage :: String -> CM.Message
 makeFailMessage = CM.message . PP.text

src/Curry/LanguageServer/Config.hs

@@ -1,4 +1,4 @@
-{-# LANGUAGE RecordWildCards, OverloadedStrings, TypeApplications #-}
+{-# LANGUAGE NoFieldSelectors, OverloadedRecordDot, RecordWildCards, OverloadedStrings, TypeApplications #-}
 module Curry.LanguageServer.Config
     ( Config (..)
     , LogLevel (..)
@@ -18,49 +18,49 @@ import Data.Aeson
 import Data.Default (Default(..))
 import qualified Data.Text as T
 
-newtype LogLevel = LogLevel { llSeverity :: Severity }
+newtype LogLevel = LogLevel { severity :: Severity }
     deriving (Show, Eq)
 
-data Config = Config { cfgForceRecompilation :: Bool
-                     , cfgImportPaths :: [FilePath]
-                     , cfgLibraryPaths :: [FilePath]
-                     , cfgLogLevel :: LogLevel
-                     , cfgCurryPath :: String
-                     , cfgUseSnippetCompletions :: Bool
+data Config = Config { forceRecompilation :: Bool
+                     , importPaths :: [FilePath]
+                     , libraryPaths :: [FilePath]
+                     , logLevel :: LogLevel
+                     , curryPath :: String
+                     , useSnippetCompletions :: Bool
                      }
     deriving (Show, Eq)
 
 instance Default Config where
-    def = Config { cfgForceRecompilation = False
-                 , cfgImportPaths = []
-                 , cfgLibraryPaths = []
-                 , cfgLogLevel = LogLevel Info
-                 , cfgCurryPath = "pakcs"
-                 , cfgUseSnippetCompletions = False
+    def = Config { forceRecompilation = False
+                 , importPaths = []
+                 , libraryPaths = []
+                 , logLevel = LogLevel Info
+                 , curryPath = "pakcs"
+                 , useSnippetCompletions = False
                  }
 
 instance FromJSON Config where
     parseJSON = withObject "Config" $ \o -> do
         c <- o .: "curry"
         l <- c .: "languageServer"
-        cfgForceRecompilation    <- l .:? "forceRecompilation"    .!= cfgForceRecompilation def
-        cfgImportPaths           <- l .:? "importPaths"           .!= cfgImportPaths def
-        cfgLibraryPaths          <- l .:? "libraryPaths"          .!= cfgLibraryPaths def
-        cfgLogLevel              <- l .:? "logLevel"              .!= cfgLogLevel def
-        cfgCurryPath             <- l .:? "curryPath"             .!= cfgCurryPath def
-        cfgUseSnippetCompletions <- l .:? "useSnippetCompletions" .!= cfgUseSnippetCompletions def
+        forceRecompilation    <- l .:? "forceRecompilation"    .!= (def @Config).forceRecompilation
+        importPaths           <- l .:? "importPaths"           .!= (def @Config).importPaths
+        libraryPaths          <- l .:? "libraryPaths"          .!= (def @Config).libraryPaths
+        logLevel              <- l .:? "logLevel"              .!= (def @Config).logLevel
+        curryPath             <- l .:? "curryPath"             .!= (def @Config).curryPath
+        useSnippetCompletions <- l .:? "useSnippetCompletions" .!= (def @Config).useSnippetCompletions
         return Config {..}
 
 instance ToJSON Config where
     toJSON Config {..} = object
         ["curry" .= object
             [ "languageServer" .= object
-                [ "forceRecompilation"    .= cfgForceRecompilation
-                , "importPaths"           .= cfgImportPaths
-                , "libraryPaths"          .= cfgLibraryPaths
-                , "logLevel"              .= cfgLogLevel
-                , "curryPath"             .= cfgCurryPath
-                , "useSnippetCompletions" .= cfgUseSnippetCompletions
+                [ "forceRecompilation"    .= forceRecompilation
+                , "importPaths"           .= importPaths
+                , "libraryPaths"          .= libraryPaths
+                , "logLevel"              .= logLevel
+                , "curryPath"             .= curryPath
+                , "useSnippetCompletions" .= useSnippetCompletions
                 ]
             ]
         ]

src/Curry/LanguageServer/Handlers/Diagnostics.hs

@@ -1,4 +1,4 @@
-{-# LANGUAGE FlexibleContexts, OverloadedStrings #-}
+{-# LANGUAGE FlexibleContexts, OverloadedStrings, OverloadedRecordDot #-}
 module Curry.LanguageServer.Handlers.Diagnostics (emitDiagnostics, fetchDiagnostics) where
 
 import Control.Monad (unless)
@@ -30,8 +30,8 @@ emitDiagnostics normUri entry = do
 
 fetchDiagnostics :: (MonadIO m, MonadLsp CFG.Config m) => J.NormalizedUri -> ModuleStoreEntry -> m [J.Diagnostic]
 fetchDiagnostics normUri entry = do
-    let warnings = map (curryMsg2Diagnostic J.DsWarning) $ mseWarningMessages entry
-        errors = map (curryMsg2Diagnostic J.DsError) $ mseErrorMessages entry
+    let warnings = map (curryMsg2Diagnostic J.DsWarning) entry.warningMessages
+        errors = map (curryMsg2Diagnostic J.DsError) entry.errorMessages
         diags = warnings ++ errors
         name = maybe "?" takeBaseName $ normalizedUriToFilePath normUri
 

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

@@ -1,4 +1,4 @@
-{-# LANGUAGE FlexibleContexts, FlexibleInstances, OverloadedStrings #-}
+{-# LANGUAGE FlexibleContexts, FlexibleInstances, OverloadedStrings, OverloadedRecordDot #-}
 module Curry.LanguageServer.Handlers.TextDocument.CodeAction (codeActionHandler) where
 
 -- Curry Compiler Libraries + Dependencies
@@ -39,7 +39,7 @@ codeActionHandler = S.requestHandler J.STextDocumentCodeAction $ \req responder
 
 fetchCodeActions :: (MonadIO m, MonadLsp CFG.Config m) => J.Range -> I.ModuleStoreEntry -> m [J.CodeAction]
 fetchCodeActions range entry = do
-    actions <- maybe (pure []) (codeActions range) $ I.mseModuleAST entry
+    actions <- maybe (pure []) (codeActions range) entry.moduleAST
     debugM $ "Found " <> T.pack (show (length actions)) <> " code action(s)"
     return actions
 

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

@@ -1,4 +1,4 @@
-{-# LANGUAGE FlexibleContexts, FlexibleInstances, OverloadedStrings #-}
+{-# LANGUAGE FlexibleContexts, FlexibleInstances, OverloadedStrings, OverloadedRecordDot #-}
 module Curry.LanguageServer.Handlers.TextDocument.CodeLens (codeLensHandler) where
 
 -- Curry Compiler Libraries + Dependencies
@@ -40,7 +40,7 @@ codeLensHandler = S.requestHandler J.STextDocumentCodeLens $ \req responder -> d
 
 fetchCodeLenses :: (MonadIO m, MonadLsp CFG.Config m) => I.ModuleStoreEntry -> m [J.CodeLens]
 fetchCodeLenses entry = do
-    lenses <- maybe (pure []) codeLenses $ I.mseModuleAST entry
+    lenses <- maybe (pure []) codeLenses entry.moduleAST
     infoM $ "Found " <> T.pack (show (length lenses)) <> " code lens(es)"
     return lenses
 

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

@@ -1,11 +1,11 @@
-{-# LANGUAGE OverloadedStrings, FlexibleContexts, FlexibleInstances, MultiWayIf #-}
+{-# LANGUAGE NoFieldSelectors, OverloadedStrings, OverloadedRecordDot, FlexibleContexts, FlexibleInstances, MultiWayIf #-}
 module Curry.LanguageServer.Handlers.TextDocument.Completion (completionHandler) where
 
 -- Curry Compiler Libraries + Dependencies
 import qualified Curry.Syntax as CS
 import qualified Base.Types as CT
 
-import Control.Lens ((^.), (.~))
+import Control.Lens ((^.), (?~))
 import Control.Monad (join, guard)
 import Control.Monad.IO.Class (MonadIO)
 import Control.Monad.Trans (lift)
@@ -48,7 +48,7 @@ completionHandler = S.requestHandler J.STextDocumentCompletion $ \req responder
         query <- MaybeT $ VFS.getCompletionPrefix pos vfile
 
         let opts = CompletionOptions
-                { cmoUseSnippets = CFG.cfgUseSnippetCompletions cfg && fromMaybe False (do
+                { useSnippets = cfg.useSnippetCompletions && fromMaybe False (do
                     docCapabilities <- capabilities ^. J.textDocument
                     cmCapabilities <- docCapabilities ^. J.completion
                     ciCapabilities <- cmCapabilities ^. J.completionItem
@@ -101,7 +101,7 @@ importCompletions opts store query = do
 
 generalCompletions :: (MonadIO m, MonadLsp CFG.Config m) => CompletionOptions -> I.ModuleStoreEntry -> I.IndexStore -> VFS.PosPrefixInfo -> m [J.CompletionItem]
 generalCompletions opts entry store query = do
-    let localIdentifiers   = join <$> maybe M.empty (`findScopeAtPos` VFS.cursorPos query) (I.mseModuleAST entry)
+    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
@@ -125,35 +125,35 @@ data Tagged a = Tagged [J.CompletionItemTag] a
 
 data CompletionSymbol = CompletionSymbol
     { -- The index symbol
-      cmsSymbol :: I.Symbol
+      symbol :: I.Symbol
       -- The, possibly aliased, module name. Nothing means that the symbol is available unqualified.
-    , cmsModuleName :: Maybe T.Text
+    , moduleName :: Maybe T.Text
       -- Import edits to apply after the completion has been selected. Nothing means that the symbol does not require an import.
-    , cmsImportEdits :: Maybe [J.TextEdit]
+    , importEdits :: Maybe [J.TextEdit]
     }
 
 newtype CompletionOptions = CompletionOptions
-    { cmoUseSnippets :: Bool
+    { useSnippets :: Bool
     }
 
 -- | Turns an index symbol into completion symbols by analyzing the module's imports.
 toCompletionSymbols :: I.ModuleStoreEntry -> I.Symbol -> [CompletionSymbol]
 toCompletionSymbols entry s = do
-    CS.Module _ _ _ mid _ imps _ <- maybeToList $ I.mseModuleAST entry
+    CS.Module _ _ _ mid _ imps _ <- maybeToList entry.moduleAST
     let pre = "Prelude"
         impNames = S.fromList [ppToText mid' | CS.ImportDecl _ mid' _ _ _ <- imps]
 
     if | I.sKind s == I.Module -> return CompletionSymbol
-            { cmsSymbol = s
-            , cmsModuleName = Nothing
-            , cmsImportEdits = Nothing
+            { 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]
             return CompletionSymbol
-                { cmsSymbol = s
-                , cmsModuleName = m
-                , cmsImportEdits = Nothing
+                { symbol = s
+                , moduleName = m
+                , importEdits = Nothing
                 }
        | otherwise -> do
             CS.ImportDecl _ mid' isQual alias spec <- imps
@@ -167,9 +167,9 @@ toCompletionSymbols entry s = do
 
             m <- moduleNames
             return CompletionSymbol
-                { cmsSymbol = s
-                , cmsModuleName = m
-                , cmsImportEdits = if isImported $ I.sIdent s
+                { symbol = s
+                , moduleName = m
+                , importEdits = if isImported $ I.sIdent s
                     then Nothing
                     else case spec of
                         Just (CS.Importing _ is) -> do
@@ -187,8 +187,8 @@ toCompletionSymbols entry s = do
 fullName :: CompletionSymbol -> T.Text
 fullName cms | I.sKind s == I.Module = I.sQualIdent s
              | otherwise             = maybe "" (<> ".") moduleName <> I.sIdent s
-    where s = cmsSymbol cms
-          moduleName = cmsModuleName cms
+    where s = cms.symbol
+          moduleName = cms.moduleName
 
 -- | The fully qualified prefix of the completion query.
 fullPrefix :: VFS.PosPrefixInfo -> T.Text
@@ -219,8 +219,8 @@ class ToCompletionItems a where
 instance ToCompletionItems CompletionSymbol where
     -- | Converts a Curry value binding to a completion item.
     toCompletionItems opts query cms = [makeCompletion name ciKind detail doc insertText insertTextFormat edits]
-        where s = cmsSymbol cms
-              edits = cmsImportEdits cms
+        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
@@ -235,10 +235,10 @@ instance ToCompletionItems CompletionSymbol where
                   I.TypeClass                                    -> J.CiInterface
                   I.TypeVar                                      -> J.CiVariable
                   I.Other                                        -> J.CiText
-              insertText | cmoUseSnippets opts = Just $ makeSnippet name $ I.sPrintedArgumentTypes s
-                         | otherwise           = Just name
-              insertTextFormat | cmoUseSnippets opts = Just J.Snippet
-                               | otherwise           = Just J.PlainText
+              insertText | opts.useSnippets = Just $ makeSnippet name $ I.sPrintedArgumentTypes s
+                         | otherwise        = Just name
+              insertTextFormat | opts.useSnippets = Just J.Snippet
+                               | otherwise        = Just J.PlainText
               detail = I.sPrintedType s
               doc = Just $ T.intercalate "\n\n" $ filter (not . T.null)
                   [ if isNothing edits then "" else "_requires import_"
@@ -264,10 +264,10 @@ instance ToCompletionItems Local where
               detail = ppToText <$> t
               doc = Just "Local"
               argTypes = (ppToText <$>) $ CT.arrowArgs . CT.unpredType =<< maybeToList t
-              insertText | cmoUseSnippets opts = Just $ makeSnippet i argTypes
-                         | otherwise           = Just i
-              insertTextFormat | cmoUseSnippets opts = Just J.Snippet
-                               | otherwise           = Just J.PlainText
+              insertText | opts.useSnippets = Just $ makeSnippet i argTypes
+                         | otherwise        = Just i
+              insertTextFormat | opts.useSnippets = Just J.Snippet
+                               | otherwise        = Just J.PlainText
               edits = Nothing
 
 instance ToCompletionItems T.Text where
@@ -281,7 +281,7 @@ instance ToCompletionItems T.Text where
               edits = Nothing
 
 instance ToCompletionItems a => ToCompletionItems (Tagged a) where
-    toCompletionItems opts query (Tagged tags x) = (J.tags .~ Just (J.List tags)) <$> toCompletionItems opts query x
+    toCompletionItems opts query (Tagged tags x) = (J.tags ?~ J.List tags) <$> toCompletionItems opts query x
 
 -- | Creates a snippet with VSCode-style syntax.
 makeSnippet :: T.Text -> [T.Text] -> T.Text

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

@@ -1,4 +1,4 @@
-{-# LANGUAGE FlexibleContexts, OverloadedStrings #-}
+{-# LANGUAGE FlexibleContexts, OverloadedStrings, OverloadedRecordDot #-}
 module Curry.LanguageServer.Handlers.TextDocument.Definition (definitionHandler) where
 
 import Control.Lens ((^.))
@@ -30,15 +30,15 @@ definitionHandler = S.requestHandler J.STextDocumentDefinition $ \req responder
     normUri <- normalizeUriWithPath uri
     store <- getStore
     defs <- runMaybeT $ do
-        lift $ debugM $ "Looking up " <> J.getUri (J.fromNormalizedUri normUri) <> " in " <> T.pack (show (M.keys $ I.idxModules store))
+        lift $ debugM $ "Looking up " <> J.getUri (J.fromNormalizedUri normUri) <> " in " <> T.pack (show (M.keys store.modules))
         entry <- I.getModule normUri
         lift $ fetchDefinitions store entry pos
     responder $ Right $ J.InR $ J.InR $ J.List $ fromMaybe [] defs
 
 fetchDefinitions :: (MonadIO m, MonadLsp CFG.Config m) => I.IndexStore -> I.ModuleStoreEntry -> J.Position -> m [J.LocationLink]
 fetchDefinitions store entry pos = do
     defs <- (fromMaybe [] <$>) $ runMaybeT $ do
-        ast <- liftMaybe $ I.mseModuleAST entry
+        ast <- liftMaybe entry.moduleAST
         definitions store ast pos
     infoM $ "Found " <> T.pack (show (length defs)) <> " definition(s)"
     return defs

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

@@ -1,4 +1,4 @@
-{-# LANGUAGE FlexibleContexts, OverloadedStrings #-}
+{-# LANGUAGE FlexibleContexts, OverloadedStrings, OverloadedRecordDot #-}
 module Curry.LanguageServer.Handlers.TextDocument.DocumentSymbol (documentSymbolHandler) where
 
 import Control.Monad.IO.Class (MonadIO (..))
@@ -30,6 +30,6 @@ documentSymbolHandler = S.requestHandler J.STextDocumentDocumentSymbol $ \req re
 
 fetchDocumentSymbols :: (MonadIO m, MonadLsp CFG.Config m) => I.ModuleStoreEntry -> m [J.DocumentSymbol]
 fetchDocumentSymbols entry = do
-    let symbols = maybe [] documentSymbols $ I.mseModuleAST entry
+    let symbols = maybe [] documentSymbols entry.moduleAST
     debugM $ "Found document symbols " <> T.pack (show symbols)
     return symbols