1{-# language PackageImports, BlockArguments #-} 2 3module Language.PureScript.Ide.Externs 4 ( readExternFile 5 , convertExterns 6 ) where 7 8import Protolude hiding (to, from, (&)) 9 10import Codec.CBOR.Term as Term 11import "monad-logger" Control.Monad.Logger 12import Data.Version (showVersion) 13import qualified Data.Text as Text 14import qualified Language.PureScript as P 15import qualified Language.PureScript.Make.Monad as Make 16import Language.PureScript.Ide.Error (IdeError (..)) 17import Language.PureScript.Ide.Types 18import Language.PureScript.Ide.Util (properNameT) 19import Lens.Micro.Platform 20 21readExternFile 22 :: (MonadIO m, MonadError IdeError m, MonadLogger m) 23 => FilePath 24 -> m P.ExternsFile 25readExternFile fp = do 26 externsFile <- liftIO (Make.readCborFileIO fp) 27 case externsFile of 28 Just externs | version == P.efVersion externs -> 29 pure externs 30 _ -> 31 liftIO (Make.readCborFileIO fp) >>= \case 32 Just (Term.TList (_tag : Term.TString efVersion : _rest)) -> do 33 let errMsg = 34 "Version mismatch for the externs at: " 35 <> toS fp 36 <> " Expected: " <> version 37 <> " Found: " <> efVersion 38 logErrorN errMsg 39 throwError (GeneralError errMsg) 40 _ -> 41 throwError (GeneralError ("Parsing the extern at: " <> toS fp <> " failed")) 42 where 43 version = toS (showVersion P.version) 44 45convertExterns :: P.ExternsFile -> ([IdeDeclarationAnn], [(P.ModuleName, P.DeclarationRef)]) 46convertExterns ef = 47 (decls, exportDecls) 48 where 49 decls = moduleDecl : map 50 (IdeDeclarationAnn emptyAnn) 51 (resolvedDeclarations <> operatorDecls <> tyOperatorDecls) 52 exportDecls = mapMaybe convertExport (P.efExports ef) 53 operatorDecls = convertOperator <$> P.efFixities ef 54 tyOperatorDecls = convertTypeOperator <$> P.efTypeFixities ef 55 moduleDecl = IdeDeclarationAnn emptyAnn (IdeDeclModule (P.efModuleName ef)) 56 (toResolve, declarations) = 57 second catMaybes (partitionEithers (map convertDecl (P.efDeclarations ef))) 58 resolvedDeclarations = resolveSynonymsAndClasses toResolve declarations 59 60resolveSynonymsAndClasses 61 :: [ToResolve] 62 -> [IdeDeclaration] 63 -> [IdeDeclaration] 64resolveSynonymsAndClasses trs decls = foldr go decls trs 65 where 66 go tr acc = case tr of 67 TypeClassToResolve tcn -> 68 case findType (P.coerceProperName tcn) acc of 69 Nothing -> 70 acc 71 Just tyDecl -> IdeDeclTypeClass 72 (IdeTypeClass tcn (tyDecl^.ideTypeKind) []) 73 : filter (not . anyOf (_IdeDeclType.ideTypeName) (== P.coerceProperName tcn)) acc 74 SynonymToResolve tn ty -> 75 case findType tn acc of 76 Nothing -> 77 acc 78 Just tyDecl -> 79 IdeDeclTypeSynonym (IdeTypeSynonym tn ty (tyDecl^.ideTypeKind)) 80 : filter (not . anyOf (_IdeDeclType.ideTypeName) (== tn)) acc 81 82findType :: P.ProperName 'P.TypeName -> [IdeDeclaration] -> Maybe IdeType 83findType tn decls = 84 decls 85 & mapMaybe (preview _IdeDeclType) 86 & find ((==) tn . view ideTypeName) 87 88-- The Externs format splits information about synonyms across EDType 89-- and EDTypeSynonym declarations. For type classes it split them 90-- across an EDType and an EDClass . We collect these and resolve them 91-- at the end of the conversion process. 92data ToResolve 93 = TypeClassToResolve (P.ProperName 'P.ClassName) 94 | SynonymToResolve (P.ProperName 'P.TypeName) P.SourceType 95 96convertExport :: P.DeclarationRef -> Maybe (P.ModuleName, P.DeclarationRef) 97convertExport (P.ReExportRef _ src r) = Just (P.exportSourceDefinedIn src, r) 98convertExport _ = Nothing 99 100convertDecl :: P.ExternsDeclaration -> Either ToResolve (Maybe IdeDeclaration) 101convertDecl ed = case ed of 102 -- We need to filter all types and synonyms that contain a '$' 103 -- because those are typechecker internal definitions that shouldn't 104 -- be user facing 105 P.EDType{..} -> Right do 106 guard (isNothing (Text.find (== '$') (edTypeName^.properNameT))) 107 Just (IdeDeclType (IdeType edTypeName edTypeKind [])) 108 P.EDTypeSynonym{..} -> 109 if isNothing (Text.find (== '$') (edTypeSynonymName^.properNameT)) 110 then Left (SynonymToResolve edTypeSynonymName edTypeSynonymType) 111 else Right Nothing 112 P.EDDataConstructor{..} -> Right do 113 guard (isNothing (Text.find (== '$') (edDataCtorName^.properNameT))) 114 Just 115 (IdeDeclDataConstructor 116 (IdeDataConstructor edDataCtorName edDataCtorTypeCtor edDataCtorType)) 117 P.EDValue{..} -> 118 Right (Just (IdeDeclValue (IdeValue edValueName edValueType))) 119 P.EDClass{..} -> 120 Left (TypeClassToResolve edClassName) 121 P.EDInstance{} -> 122 Right Nothing 123 124convertOperator :: P.ExternsFixity -> IdeDeclaration 125convertOperator P.ExternsFixity{..} = 126 IdeDeclValueOperator 127 (IdeValueOperator 128 efOperator 129 efAlias 130 efPrecedence 131 efAssociativity 132 Nothing) 133 134convertTypeOperator :: P.ExternsTypeFixity -> IdeDeclaration 135convertTypeOperator P.ExternsTypeFixity{..} = 136 IdeDeclTypeOperator 137 (IdeTypeOperator 138 efTypeOperator 139 efTypeAlias 140 efTypePrecedence 141 efTypeAssociativity 142 Nothing) 143