ihaskell 0.10.2.1 → 0.10.2.2
raw patch · 26 files changed
+641/−154 lines, 26 filesdep +binarydep −cerealdep −mtldep ~aesondep ~basedep ~bytestring
Dependencies added: binary
Dependencies removed: cereal, mtl
Dependency ranges changed: aeson, base, bytestring, containers, ghc, ghc-boot, ipython-kernel, process, random, strict, text, time, unix
Files
- ihaskell.cabal +59/−51
- jupyterlab-ihaskell/labextension/package.json +54/−0
- jupyterlab-ihaskell/labextension/static/568-1b6fb876268b3f3be3f4.js +1/−0
- jupyterlab-ihaskell/labextension/static/remoteEntry-ddc4c9d791a676e50bb9.js +1/−0
- jupyterlab-ihaskell/labextension/static/style.js +4/−0
- jupyterlab-ihaskell/labextension/static/third-party-licenses.json +3/−0
- main/Main.hs +31/−9
- src/IHaskell/Convert.hs +1/−2
- src/IHaskell/Convert/Args.hs +1/−5
- src/IHaskell/Convert/IpynbToLhs.hs +7/−1
- src/IHaskell/Convert/LhsToIpynb.hs +10/−0
- src/IHaskell/Display.hs +11/−5
- src/IHaskell/Eval/Completion.hs +14/−5
- src/IHaskell/Eval/Evaluate.hs +182/−25
- src/IHaskell/Eval/Hoogle.hs +0/−1
- src/IHaskell/Eval/Info.hs +4/−1
- src/IHaskell/Eval/Lint.hs +4/−2
- src/IHaskell/Eval/Parser.hs +4/−1
- src/IHaskell/Eval/Util.hs +72/−11
- src/IHaskell/Eval/Widgets.hs +76/−23
- src/IHaskell/Flags.hs +11/−2
- src/IHaskell/IPython.hs +30/−1
- src/IHaskell/Types.hs +45/−7
- src/tests/IHaskell/Test/Completion.hs +9/−0
- src/tests/IHaskell/Test/Eval.hs +4/−1
- src/tests/IHaskell/Test/Parser.hs +3/−1
ihaskell.cabal view
@@ -7,7 +7,7 @@ -- PVP summary: +--+------- breaking API changes -- | | +----- non-breaking API additions -- | | | +--- code changes with no API change-version: 0.10.2.1+version: 0.10.2.2 -- A short (one-line) description of the package. synopsis: A Haskell backend kernel for the IPython project.@@ -45,7 +45,15 @@ data-files: html/kernel.js html/logo-64x64.svg+ jupyterlab-ihaskell/labextension/package.json+ jupyterlab-ihaskell/labextension/static/*.js+ jupyterlab-ihaskell/labextension/static/*.json +flag use-hlint+ description: Include HLint support+ default: True+ manual: True+ library hs-source-dirs: src default-language: Haskell2010@@ -55,44 +63,38 @@ ghc-options: -Wpartial-fields build-depends:+ base >=4.9 && <4.17,+ binary ,+ containers ,+ directory ,+ bytestring ,+ exceptions ,+ filepath ,+ ghc >=8.0 && <9.3,+ ghc-boot ,+ haskeline ,+ parsec ,+ process ,+ random ,+ stm ,+ text ,+ time ,+ transformers ,+ unix , aeson >=1.0,- base >=4.9, base64-bytestring >=1.0,- bytestring >=0.10,- cereal >=0.3, cmdargs >=0.10,- containers >=0.5,- directory -any,- exceptions -any,- filepath -any,- ghc >=8.0, ghc-parser >=0.2.1, ghc-paths >=0.1,- haskeline -any,- hlint >=1.9,- http-client >= 0.4,- http-client-tls >= 0.2,- mtl >=2.1,- parsec -any,- process >=1.1,- random >=1.0,+ http-client >=0.4,+ http-client-tls >=0.2, shelly >=1.5,- split >= 0.2,- stm -any,+ split >=0.2, strict >=0.3,- text >=0.11,- time >= 1.6,- transformers -any,- unix >= 2.6, unordered-containers -any, utf8-string -any, vector -any,- ipython-kernel >=0.10.2.0,- ghc-boot >=8.0 && <9.1-- if impl (ghc < 8.10)- build-depends:- haskell-src-exts >=1.18+ ipython-kernel >=0.10.2.0 exposed-modules: IHaskell.Display IHaskell.Convert@@ -103,7 +105,6 @@ IHaskell.Eval.Inspect IHaskell.Eval.Evaluate IHaskell.Eval.Info- IHaskell.Eval.Lint IHaskell.Eval.Parser IHaskell.Eval.Hoogle IHaskell.Eval.ParseShell@@ -121,13 +122,21 @@ other-modules: StringUtils + if flag(use-hlint)+ exposed-modules: IHaskell.Eval.Lint+ build-depends: hlint >=1.9+ cpp-options: -DUSE_HLINT++ if flag(use-hlint) && impl (ghc < 8.10)+ build-depends: haskell-src-exts >=1.18+ executable ihaskell -- .hs or .lhs file containing the Main module. main-is: Main.hs hs-source-dirs: main other-modules: Paths_ihaskell- ghc-options: -threaded -rtsopts -Wall -dynamic+ ghc-options: -threaded -rtsopts -Wall if os(darwin) ghc-options: -optP-Wno-nonportable-include-path@@ -138,21 +147,20 @@ -- Other library packages from which modules are imported. default-language: Haskell2010 build-depends:- ihaskell -any,- base >=4.9 && < 4.16,- text >=0.11,- transformers -any,- ghc >=8.0 && < 9.1,- process >=1.1,- aeson >=0.7,- bytestring >=0.10,- unordered-containers -any,- containers >=0.5,- strict >=0.3,- unix >= 2.6,- directory -any,- ipython-kernel >=0.10,- unordered-containers -any+ base ,+ bytestring ,+ containers ,+ directory ,+ text ,+ transformers ,+ ghc ,+ process ,+ unix ,+ aeson ,+ ihaskell ,+ ipython-kernel ,+ strict ,+ unordered-containers Test-Suite hspec Type: exitcode-stdio-1.0@@ -172,16 +180,16 @@ default-language: Haskell2010 build-depends: base,- ihaskell,- here,- hspec,- hspec-contrib,- HUnit, ghc, ghc-paths, transformers, directory, text,+ ihaskell,+ here,+ hspec,+ hspec-contrib,+ HUnit, shelly, raw-strings-qq, setenv
+ jupyterlab-ihaskell/labextension/package.json view
@@ -0,0 +1,54 @@+{+ "name": "jupyterlab-ihaskell",+ "version": "0.0.14",+ "description": "adds ihaskell syntax highlighting to jupyterlab",+ "keywords": [+ "jupyter",+ "jupyterlab",+ "ihaskell",+ "jupyterlab-extension"+ ],+ "homepage": "https://github.com/gibiansky/IHaskell/",+ "bugs": {+ "url": "https://github.com/gibiansky/IHaskell/issues"+ },+ "license": "BSD-3-Clause",+ "author": "MMesch",+ "files": [+ "lib/**/*.{d.ts,js,js.map,json}"+ ],+ "main": "lib/index.js",+ "types": "lib/index.d.ts",+ "repository": {+ "type": "git",+ "url": "git@github.com:gibiansky/IHaskell.git"+ },+ "scripts": {+ "build": "tsc",+ "clean": "rimraf lib",+ "watch": "tsc -w"+ },+ "dependencies": {+ "@jupyterlab/application": ">=3.0.0",+ "@jupyterlab/codemirror": ">=3.0.0",+ "@jupyterlab/apputils": ">=3.0.0",+ "@jupyterlab/docregistry": ">=3.0.0",+ "@jupyterlab/notebook": ">=3.0.0",+ "@jupyterlab/services": ">=6.0.0"+ },+ "devDependencies": {+ "rimraf": "^3.0.0",+ "typescript": "~3.7.3",+ "@types/codemirror": ">=0.0.0",+ "@jupyterlab/builder": ">=3.0.0"+ },+ "jupyterlab": {+ "extension": true,+ "outputDir": "labextension",+ "webpackConfig": "./webpack.config.js",+ "_build": {+ "load": "static/remoteEntry-ddc4c9d791a676e50bb9.js",+ "extension": "./extension"+ }+ }+}
+ jupyterlab-ihaskell/labextension/static/568-1b6fb876268b3f3be3f4.js view
@@ -0,0 +1,1 @@+"use strict";(self.webpackChunkjupyterlab_ihaskell=self.webpackChunkjupyterlab_ihaskell||[]).push([[568],{291:function(e,t,l){var i=this&&this.__awaiter||function(e,t,l,i){return new(l||(l=Promise))((function(n,o){function r(e){try{s(i.next(e))}catch(e){o(e)}}function a(e){try{s(i.throw(e))}catch(e){o(e)}}function s(e){var t;e.done?n(e.value):(t=e.value,t instanceof l?t:new l((function(e){e(t)}))).then(r,a)}s((i=i.apply(e,t||[])).next())}))};Object.defineProperty(t,"__esModule",{value:!0});const n=l(36);t.defineIHaskellMode=function({CodeMirror:e}){return i(this,void 0,void 0,(function*(){yield n.Mode.ensure("haskell"),yield n.Mode.ensure("r"),e.defineMode("ihaskell",(t=>{let l=e.getMode(t,"haskell");return e.multiplexingMode(l,{open:/:(?=!)/,close:/^(?!!)/,mode:e.getMode(t,"text/plain"),delimStyle:"delimit"},{open:/\[r\||\[rprint\||\[rgraph\|/,close:/\|\]/,mode:e.getMode(t,"text/x-rsrc"),delimStyle:"delimit"})})),e.defineMIME("text/x-ihaskell","ihaskell"),e.modeInfo.push({ext:["hs"],mime:"text/x-ihaskell",mode:"ihaskell",name:"ihaskell"})}))}},568:(e,t,l)=>{Object.defineProperty(t,"__esModule",{value:!0});const i=l(36),n=l(291),o={id:"ihaskell",autoStart:!0,requires:[i.ICodeMirror],activate:(e,t)=>{n.defineIHaskellMode(t).catch(console.warn)}};t.default=o}}]);
+ jupyterlab-ihaskell/labextension/static/remoteEntry-ddc4c9d791a676e50bb9.js view
@@ -0,0 +1,1 @@+var _JUPYTERLAB;(()=>{"use strict";var e,r,t,n,o,a,i,l,u,s,f,p,h,c,d,v={494:(e,r,t)=>{var n={"./index":()=>t.e(568).then((()=>()=>t(568))),"./extension":()=>t.e(568).then((()=>()=>t(568)))},o=(e,r)=>(t.R=r,r=t.o(n,e)?n[e]():Promise.resolve().then((()=>{throw new Error('Module "'+e+'" does not exist in container.')})),t.R=void 0,r),a=(e,r)=>{if(t.S){var n=t.S.default,o="default";if(n&&n!==e)throw new Error("Container initialization failed as it has already been initialized with a different share scope");return t.S[o]=e,t.I(o,r)}};t.d(r,{get:()=>o,init:()=>a})}},b={};function g(e){var r=b[e];if(void 0!==r)return r.exports;var t=b[e]={exports:{}};return v[e].call(t.exports,t,t.exports,g),t.exports}g.m=v,g.c=b,g.d=(e,r)=>{for(var t in r)g.o(r,t)&&!g.o(e,t)&&Object.defineProperty(e,t,{enumerable:!0,get:r[t]})},g.f={},g.e=e=>Promise.all(Object.keys(g.f).reduce(((r,t)=>(g.f[t](e,r),r)),[])),g.u=e=>e+"-1b6fb876268b3f3be3f4.js",g.g=function(){if("object"==typeof globalThis)return globalThis;try{return this||new Function("return this")()}catch(e){if("object"==typeof window)return window}}(),g.o=(e,r)=>Object.prototype.hasOwnProperty.call(e,r),e={},r="jupyterlab-ihaskell:",g.l=(t,n,o,a)=>{if(e[t])e[t].push(n);else{var i,l;if(void 0!==o)for(var u=document.getElementsByTagName("script"),s=0;s<u.length;s++){var f=u[s];if(f.getAttribute("src")==t||f.getAttribute("data-webpack")==r+o){i=f;break}}i||(l=!0,(i=document.createElement("script")).charset="utf-8",i.timeout=120,g.nc&&i.setAttribute("nonce",g.nc),i.setAttribute("data-webpack",r+o),i.src=t),e[t]=[n];var p=(r,n)=>{i.onerror=i.onload=null,clearTimeout(h);var o=e[t];if(delete e[t],i.parentNode&&i.parentNode.removeChild(i),o&&o.forEach((e=>e(n))),r)return r(n)},h=setTimeout(p.bind(null,void 0,{type:"timeout",target:i}),12e4);i.onerror=p.bind(null,i.onerror),i.onload=p.bind(null,i.onload),l&&document.head.appendChild(i)}},(()=>{g.S={};var e={},r={};g.I=(t,n)=>{n||(n=[]);var o=r[t];if(o||(o=r[t]={}),!(n.indexOf(o)>=0)){if(n.push(o),e[t])return e[t];g.o(g.S,t)||(g.S[t]={});var a=g.S[t],i="jupyterlab-ihaskell",l=[];switch(t){case"default":((e,r,t,n)=>{var o=a[e]=a[e]||{},l=o[r];(!l||!l.loaded&&(1!=!l.eager?n:i>l.from))&&(o[r]={get:()=>g.e(568).then((()=>()=>g(568))),from:i,eager:!1})})("jupyterlab-ihaskell","0.0.14")}return e[t]=l.length?Promise.all(l).then((()=>e[t]=1)):1}}})(),(()=>{var e;g.g.importScripts&&(e=g.g.location+"");var r=g.g.document;if(!e&&r&&(r.currentScript&&(e=r.currentScript.src),!e)){var t=r.getElementsByTagName("script");t.length&&(e=t[t.length-1].src)}if(!e)throw new Error("Automatic publicPath is not supported in this browser");e=e.replace(/#.*$/,"").replace(/\?.*$/,"").replace(/\/[^\/]+$/,"/"),g.p=e})(),t=e=>{var r=e=>e.split(".").map((e=>+e==e?+e:e)),t=/^([^-+]+)?(?:-([^+]+))?(?:\+(.+))?$/.exec(e),n=t[1]?r(t[1]):[];return t[2]&&(n.length++,n.push.apply(n,r(t[2]))),t[3]&&(n.push([]),n.push.apply(n,r(t[3]))),n},n=(e,r)=>{e=t(e),r=t(r);for(var n=0;;){if(n>=e.length)return n<r.length&&"u"!=(typeof r[n])[0];var o=e[n],a=(typeof o)[0];if(n>=r.length)return"u"==a;var i=r[n],l=(typeof i)[0];if(a!=l)return"o"==a&&"n"==l||"s"==l||"u"==a;if("o"!=a&&"u"!=a&&o!=i)return o<i;n++}},o=e=>{var r=e[0],t="";if(1===e.length)return"*";if(r+.5){t+=0==r?">=":-1==r?"<":1==r?"^":2==r?"~":r>0?"=":"!=";for(var n=1,a=1;a<e.length;a++)n--,t+="u"==(typeof(l=e[a]))[0]?"-":(n>0?".":"")+(n=2,l);return t}var i=[];for(a=1;a<e.length;a++){var l=e[a];i.push(0===l?"not("+u()+")":1===l?"("+u()+" || "+u()+")":2===l?i.pop()+" "+i.pop():o(l))}return u();function u(){return i.pop().replace(/^\((.+)\)$/,"$1")}},a=(e,r)=>{if(0 in e){r=t(r);var n=e[0],o=n<0;o&&(n=-n-1);for(var i=0,l=1,u=!0;;l++,i++){var s,f,p=l<e.length?(typeof e[l])[0]:"";if(i>=r.length||"o"==(f=(typeof(s=r[i]))[0]))return!u||("u"==p?l>n&&!o:""==p!=o);if("u"==f){if(!u||"u"!=p)return!1}else if(u)if(p==f)if(l<=n){if(s!=e[l])return!1}else{if(o?s>e[l]:s<e[l])return!1;s!=e[l]&&(u=!1)}else if("s"!=p&&"n"!=p){if(o||l<=n)return!1;u=!1,l--}else{if(l<=n||f<p!=o)return!1;u=!1}else"s"!=p&&"n"!=p&&(u=!1,l--)}}var h=[],c=h.pop.bind(h);for(i=1;i<e.length;i++){var d=e[i];h.push(1==d?c()|c():2==d?c()&c():d?a(d,r):!c())}return!!c()},i=(e,r)=>{var t=g.S[e];if(!t||!g.o(t,r))throw new Error("Shared module "+r+" doesn't exist in shared scope "+e);return t},l=(e,r)=>{var t=e[r];return Object.keys(t).reduce(((e,r)=>!e||!t[e].loaded&&n(e,r)?r:e),0)},u=(e,r,t)=>"Unsatisfied version "+r+" of shared singleton module "+e+" (required "+o(t)+")",s=(e,r,t,n)=>{var o=l(e,t);return a(n,o)||"undefined"!=typeof console&&console.warn&&console.warn(u(t,o,n)),f(e[t][o])},f=e=>(e.loaded=1,e.get()),p=(e=>function(r,t,n,o){var a=g.I(r);return a&&a.then?a.then(e.bind(e,r,g.S[r],t,n,o)):e(r,g.S[r],t,n)})(((e,r,t,n)=>(i(e,t),s(r,0,t,n)))),h={},c={36:()=>p("default","@jupyterlab/codemirror",[1,3,0,7])},d={568:[36]},g.f.consumes=(e,r)=>{g.o(d,e)&&d[e].forEach((e=>{if(g.o(h,e))return r.push(h[e]);var t=r=>{h[e]=0,g.m[e]=t=>{delete g.c[e],t.exports=r()}},n=r=>{delete h[e],g.m[e]=t=>{throw delete g.c[e],r}};try{var o=c[e]();o.then?r.push(h[e]=o.then(t).catch(n)):t(o)}catch(e){n(e)}}))},(()=>{var e={589:0};g.f.j=(r,t)=>{var n=g.o(e,r)?e[r]:void 0;if(0!==n)if(n)t.push(n[2]);else{var o=new Promise(((t,o)=>n=e[r]=[t,o]));t.push(n[2]=o);var a=g.p+g.u(r),i=new Error;g.l(a,(t=>{if(g.o(e,r)&&(0!==(n=e[r])&&(e[r]=void 0),n)){var o=t&&("load"===t.type?"missing":t.type),a=t&&t.target&&t.target.src;i.message="Loading chunk "+r+" failed.\n("+o+": "+a+")",i.name="ChunkLoadError",i.type=o,i.request=a,n[1](i)}}),"chunk-"+r,r)}};var r=(r,t)=>{var n,o,[a,i,l]=t,u=0;if(a.some((r=>0!==e[r]))){for(n in i)g.o(i,n)&&(g.m[n]=i[n]);l&&l(g)}for(r&&r(t);u<a.length;u++)o=a[u],g.o(e,o)&&e[o]&&e[o][0](),e[a[u]]=0},t=self.webpackChunkjupyterlab_ihaskell=self.webpackChunkjupyterlab_ihaskell||[];t.forEach(r.bind(null,0)),t.push=r.bind(null,t.push.bind(t))})();var m=g(494);(_JUPYTERLAB=void 0===_JUPYTERLAB?{}:_JUPYTERLAB)["jupyterlab-ihaskell"]=m})();
+ jupyterlab-ihaskell/labextension/static/style.js view
@@ -0,0 +1,4 @@+/* This is a generated file of CSS imports */+/* It was generated by @jupyterlab/builder in Build.ensureAssets() */++
+ jupyterlab-ihaskell/labextension/static/third-party-licenses.json view
@@ -0,0 +1,3 @@+{+ "packages": []+}
main/Main.hs view
@@ -15,12 +15,11 @@ import Data.Aeson hiding (Success) import System.Process (readProcess, readProcessWithExitCode) import System.Exit (exitSuccess, ExitCode(ExitSuccess))-import Control.Exception (try, SomeException)+import Control.Exception (try) import System.Environment (getArgs) import System.Environment (setEnv) import System.Posix.Signals import qualified Data.Map as Map-import qualified Data.HashMap.Strict as HashMap import Data.List (break, last) import Data.Version (showVersion) @@ -43,6 +42,13 @@ -- Cabal imports. import Paths_ihaskell(version) +#if MIN_VERSION_aeson(2,0,0)+import qualified Data.Aeson.KeyMap as KeyMap+import qualified Data.Aeson.Key as Key+#else+import qualified Data.HashMap.Strict as HashMap+#endif+ main :: IO () main = do args <- parseFlags <$> getArgs@@ -56,6 +62,7 @@ ihaskell (Args InstallKernelSpec args) = showingHelp InstallKernelSpec args $ do let kernelSpecOpts = parseKernelArgs args replaceIPythonKernelspec kernelSpecOpts+ installLabextension (kernelSpecDebug kernelSpecOpts) ihaskell (Args (Kernel (Just filename)) args) = do let kernelSpecOpts = parseKernelArgs args runKernel kernelSpecOpts filename@@ -98,6 +105,8 @@ kernelSpecOpts { kernelSpecInstallPrefix = Just prefix } addFlag kernelSpecOpts KernelspecUseStack = kernelSpecOpts { kernelSpecUseStack = True }+ addFlag kernelSpecOpts (KernelspecEnvFile fp) =+ kernelSpecOpts { kernelSpecEnvFile = Just fp } addFlag _kernelSpecOpts flag = error $ "Unknown flag" ++ show flag -- | Run the IHaskell language kernel.@@ -127,14 +136,13 @@ -- If we're in a stack directory, use `stack` to set the environment -- We can't do this with base <= 4.6 because setEnv doesn't exist.- when stack $ do- stackEnv <- lines <$> readProcess "stack" ["exec", "env"] ""- forM_ stackEnv $ \line ->- let (var, val) = break (== '=') line- in case tailMay val of- Nothing -> return ()- Just val' -> setEnv var val'+ when stack $+ readProcess "stack" ["exec", "env"] "" >>= parseAndSetEnv + case kernelSpecEnvFile kOpts of+ Nothing -> return ()+ Just envFile -> readFile envFile >>= parseAndSetEnv+ -- Serve on all sockets and ports defined in the profile. interface <- serveProfile profile debug @@ -210,6 +218,12 @@ isCommMessage req = mhMsgType (header req) `elem` [CommDataMessage, CommCloseMessage] + parseAndSetEnv envLines =+ forM_ (lines envLines) $ \line -> do+ case break (== '=') line of+ (_, []) -> return ()+ (key, _:val) -> setEnv key val+ -- Initial kernel state. initialKernelState :: IO (MVar KernelState) initialKernelState = newMVar defaultKernelState@@ -332,7 +346,11 @@ let start = pos - length matchedText end = pos+#if MIN_VERSION_aeson(2,0,0)+ reply = CompleteReply replyHeader (map T.pack completions) start end (Metadata KeyMap.empty) True+#else reply = CompleteReply replyHeader (map T.pack completions) start end (Metadata HashMap.empty) True+#endif return (state, reply) replyTo _ _ req@InspectRequest{} replyHeader state = do@@ -379,7 +397,11 @@ commMap = openComms state uuidTargetPairs = map (second targetName) $ Map.toList commMap +#if MIN_VERSION_aeson(2,0,0)+ pairProcessor (x, y) = (Key.fromText $ T.pack (UUID.uuidToString x)) .= object ["target_name" .= T.pack y]+#else pairProcessor (x, y) = T.pack (UUID.uuidToString x) .= object ["target_name" .= T.pack y]+#endif currentComms = object $ map pairProcessor $ (incomingUuid, "comm") : uuidTargetPairs
src/IHaskell/Convert.hs view
@@ -5,13 +5,12 @@ import IHaskellPrelude -import Control.Monad.Identity (Identity(Identity), unless, when)+import Data.Functor.Identity (Identity(Identity)) import IHaskell.Convert.Args (ConvertSpec(..), fromJustConvertSpec, toConvertSpec) import IHaskell.Convert.IpynbToLhs (ipynbToLhs) import IHaskell.Convert.LhsToIpynb (lhsToIpynb) import IHaskell.Flags (Argument) import System.Directory (doesFileExist)-import Text.Printf (printf) -- | used by @IHaskell convert@ convert :: [Argument] -> IO ()
src/IHaskell/Convert/Args.hs view
@@ -6,14 +6,10 @@ import IHaskellPrelude import qualified Data.Text.Lazy as LT -import Control.Applicative ((<$>))-import Control.Monad.Identity (Identity(Identity))+import Data.Functor.Identity (Identity(Identity)) import Data.Char (toLower)-import Data.List (partition)-import Data.Maybe (fromMaybe) import IHaskell.Flags (Argument(..), LhsStyle, lhsStyleBird, NotebookFormat(..)) import System.FilePath ((<.>), dropExtension, takeExtension)-import Text.Printf (printf) -- | ConvertSpec is the accumulator for command line arguments data ConvertSpec f =
src/IHaskell/Convert/IpynbToLhs.hs view
@@ -1,5 +1,6 @@ {-# LANGUAGE NoImplicitPrelude, OverloadedStrings #-} {-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE CPP #-} module IHaskell.Convert.IpynbToLhs (ipynbToLhs) where @@ -9,12 +10,17 @@ import Data.Aeson (decode, Object, Value(Array, Object, String)) import Data.Vector (Vector)-import Data.HashMap.Strict (lookup) import qualified Data.Text.Lazy.IO as LTIO import qualified Data.Vector as V (map, mapM, toList) import IHaskell.Flags (LhsStyle(..))++#if MIN_VERSION_aeson(2,0,0)+import Data.Aeson.KeyMap (lookup)+#else+import Data.HashMap.Strict (lookup)+#endif ipynbToLhs :: LhsStyle LText -> FilePath -- ^ the filename of an ipython notebook
src/IHaskell/Convert/LhsToIpynb.hs view
@@ -15,6 +15,12 @@ import IHaskell.Flags (LhsStyle(LhsStyle)) +#if MIN_VERSION_aeson(2,0,0)+import qualified Data.Aeson.KeyMap as KeyMap+import qualified Data.Aeson.Key as Key+#else+#endif+ lhsToIpynb :: LhsStyle LText -> FilePath -> FilePath -> IO () lhsToIpynb sty from to = do classed <- classifyLines sty . LT.lines . LT.pack <$> readFile from@@ -82,7 +88,11 @@ -- | ihaskell needs this boilerplate at the upper level to interpret the json describing cells and -- output correctly.+#if MIN_VERSION_aeson(2,0,0)+boilerplate :: [(Key.Key, Value)]+#else boilerplate :: [(T.Text, Value)]+#endif boilerplate = ["metadata" .= object [kernelspec, lang], "nbformat" .= Number 4, "nbformat_minor" .= Number 0] where
src/IHaskell/Display.hs view
@@ -37,6 +37,7 @@ vega, vegalite, vdom,+ widgetdisplay, custom, many, @@ -59,8 +60,9 @@ import IHaskellPrelude import qualified Data.Text as T import qualified Data.ByteString.Char8 as CBS+import qualified Data.ByteString.Lazy as LBS -import Data.Serialize as Serialize+import Data.Binary as Binary import qualified Data.ByteString.Base64 as Base64 import System.Directory (getTemporaryDirectory, setCurrentDirectory) @@ -150,6 +152,10 @@ jpg :: Width -> Height -> Base64 -> DisplayData jpg width height = DisplayData (MimeJpg width height) +-- | Generate a Widget display given the uuid and the view version+widgetdisplay :: String -> DisplayData+widgetdisplay = DisplayData MimeWidget .T.pack+ -- | Convert from a string into base 64 encoded data. encode64 :: String -> Base64 encode64 str = base64 $ CBS.pack str@@ -159,8 +165,8 @@ base64 = E.decodeUtf8 . Base64.encode -- | For internal use within IHaskell. Serialize displays to a ByteString.-serializeDisplay :: Display -> ByteString-serializeDisplay = Serialize.encode+serializeDisplay :: Display -> LBS.ByteString+serializeDisplay = Binary.encode -- | Items written to this chan will be included in the output sent to the frontend (ultimately the -- browser), the next time IHaskell has an item to display.@@ -170,9 +176,9 @@ -- | Take everything that was put into the 'displayChan' at that point out, and make a 'Display' out -- of it.-displayFromChanEncoded :: IO ByteString+displayFromChanEncoded :: IO LBS.ByteString displayFromChanEncoded =- Serialize.encode <$> Just . many <$> unfoldM (atomically $ tryReadTChan displayChan)+ Binary.encode <$> Just . many <$> unfoldM (atomically $ tryReadTChan displayChan) -- | Write to the display channel. The contents will be displayed in the notebook once the current -- execution call ends.
src/IHaskell/Eval/Completion.hs view
@@ -14,19 +14,24 @@ import IHaskellPrelude -import Control.Applicative ((<$>)) import Data.Char-import Data.List (nub, init, last, elemIndex, concatMap)+import Data.List (init, last, elemIndex) import qualified Data.List.Split as Split import qualified Data.List.Split.Internals as Split import System.Environment (getEnv) import GHC-#if MIN_VERSION_ghc(9,0,0)+#if MIN_VERSION_ghc(9,2,0) import GHC.Unit.Database import GHC.Unit.State+import GHC.Driver.Ppr import GHC.Driver.Session import GHC.Driver.Monad as GhcMonad+#elif MIN_VERSION_ghc(9,0,0)+import GHC.Unit.Database+import GHC.Unit.State+import GHC.Driver.Session+import GHC.Driver.Monad as GhcMonad import GHC.Utils.Outputable (showPpr) #else import GHC.PackageDb@@ -81,8 +86,12 @@ let isQualified = ('.' `elem`) unqualNames = nub $ filter (not . isQualified) rdrNames qualNames = nub $ scopeNames ++ filter isQualified rdrNames--#if MIN_VERSION_ghc(9,0,0)+#if MIN_VERSION_ghc(9,2,0)+ logger <- getLogger+ (db, _, _, _) <- liftIO $ initUnits logger flags Nothing+ let getNames = map (moduleNameString . exposedName) . unitExposedModules+ moduleNames = nub $ concatMap getNames $ concatMap unitDatabaseUnits db+#elif MIN_VERSION_ghc(9,0,0) let Just db = unitDatabases flags getNames = map (moduleNameString . exposedName) . unitExposedModules moduleNames = nub $ concatMap getNames $ concatMap unitDatabaseUnits db
src/IHaskell/Eval/Evaluate.hs view
@@ -23,24 +23,36 @@ import Control.Concurrent (forkIO, threadDelay) import Data.Foldable (foldMap) import Prelude (head, tail, last, init)-import Data.List (nubBy) import qualified Data.Set as Set import Data.Char as Char import Data.Dynamic-import qualified Data.Serialize as Serialize+import qualified Data.Binary as Binary import System.Directory import System.Posix.IO (fdToHandle) import System.IO (hGetChar, hSetEncoding, utf8) import System.Random (getStdGen, randomRs) import System.Process import System.Exit-import Data.Maybe (mapMaybe) import System.Environment (getEnv) -#if MIN_VERSION_ghc(9,0,0)+#if MIN_VERSION_ghc(9,2,0) import qualified GHC.Runtime.Debugger as Debugger import GHC.Runtime.Eval import GHC.Driver.Session+import GHC.Unit.State+import Control.Monad.Catch as MC+import GHC.Utils.Outputable hiding ((<>))+import GHC.Data.Bag+import GHC.Driver.Backend+import GHC.Driver.Ppr+import GHC.Runtime.Context+import GHC.Types.SourceError+import GHC.Unit.Types (UnitId)+import qualified GHC.Utils.Error as ErrUtils+#elif MIN_VERSION_ghc(9,0,0)+import qualified GHC.Runtime.Debugger as Debugger+import GHC.Runtime.Eval+import GHC.Driver.Session import GHC.Driver.Types import GHC.Unit.State import Control.Monad.Catch as MC@@ -54,7 +66,6 @@ import DynFlags import HscTypes import InteractiveEval-import Exception (gtry) import Exception hiding (evaluate) import GhcMonad (liftIO) import Outputable hiding ((<>))@@ -68,13 +79,16 @@ import IHaskell.Types import IHaskell.IPython import IHaskell.Eval.Parser-import IHaskell.Eval.Lint import IHaskell.Display import qualified IHaskell.Eval.Hoogle as Hoogle import IHaskell.Eval.Util import IHaskell.BrokenPackages import StringUtils (replace, split, strip, rstrip) +#ifdef USE_HLINT+import IHaskell.Eval.Lint+#endif+ #if MIN_VERSION_ghc(9,0,0) import GHC.Data.FastString #elif MIN_VERSION_ghc(8,2,0)@@ -84,6 +98,11 @@ import Data.Version (versionBranch) #endif +#if MIN_VERSION_ghc(9,2,0)+showSDocUnqual :: DynFlags -> SDoc -> String+showSDocUnqual = showSDoc+#endif+ #if MIN_VERSION_ghc(9,0,0) gcatch :: Ghc a -> (SomeException -> Ghc a) -> Ghc a gcatch = MC.catch@@ -189,29 +208,43 @@ -- Run the rest of the interpreter action hasSupportLibraries -#if MIN_VERSION_ghc(9,0,0)+#if MIN_VERSION_ghc(9,2,0)+packageIdString' :: Logger -> DynFlags -> UnitInfo -> IO String+packageIdString' logger dflags pkg_cfg = do+ (_, unitState, _, _) <- initUnits logger dflags Nothing+ case (lookupUnit unitState $ mkUnit pkg_cfg) of+ Nothing -> pure "(unknown)"+ Just cfg -> let+ PackageName name = unitPackageName cfg+ in pure $ unpackFS name+#elif MIN_VERSION_ghc(9,0,0) packageIdString' :: DynFlags -> UnitInfo -> String-#else-packageIdString' :: DynFlags -> PackageConfig -> String-#endif packageIdString' dflags pkg_cfg =-#if MIN_VERSION_ghc(9,0,0) case (lookupUnit (unitState dflags) $ mkUnit pkg_cfg) of Nothing -> "(unknown)" Just cfg -> let PackageName name = unitPackageName cfg in unpackFS name #elif MIN_VERSION_ghc(8,2,0)+packageIdString' :: DynFlags -> PackageConfig -> String+packageIdString' dflags pkg_cfg = case (lookupPackage dflags $ packageConfigId pkg_cfg) of Nothing -> "(unknown)" Just cfg -> let PackageName name = packageName cfg in unpackFS name #else+packageIdString' :: DynFlags -> PackageConfig -> String+packageIdString' dflags pkg_cfg = fromMaybe "(unknown)" (unitIdPackageIdString dflags $ packageConfigId pkg_cfg) #endif -#if MIN_VERSION_ghc(9,0,0)+#if MIN_VERSION_ghc(9,2,0)+getPackageConfigs :: Logger -> DynFlags -> IO [GenUnitInfo UnitId]+getPackageConfigs logger dflags = do+ (pkgDb, _, _, _) <- initUnits logger dflags Nothing+ pure $ foldMap unitDatabaseUnits pkgDb+#elif MIN_VERSION_ghc(9,0,0) getPackageConfigs :: DynFlags -> [GenUnitInfo UnitId] getPackageConfigs dflags = foldMap unitDatabaseUnits pkgDb@@ -233,16 +266,28 @@ -- version of the ihaskell library. Also verify that the packages we load are not broken. dflags <- getSessionDynFlags broken <- liftIO getBrokenPackages-#if MIN_VERSION_ghc(9,0,0)+#if MIN_VERSION_ghc(9,2,0)+ let dflgs = dflags+#elif MIN_VERSION_ghc(9,0,0) dflgs <- liftIO $ initUnits dflags #else (dflgs, _) <- liftIO $ initPackages dflags #endif++#if MIN_VERSION_ghc(9,2,0)+ logger <- getLogger+ db <- liftIO $ getPackageConfigs logger dflgs+ packageNames <- liftIO $ mapM (packageIdString' logger dflgs) db+ let hiddenPackages = Set.intersection hiddenPackageNames (Set.fromList packageNames)+ hiddenFlags = fmap HidePackage $ Set.toList hiddenPackages+ initStr = "ihaskell-"+#else let db = getPackageConfigs dflgs packageNames = map (packageIdString' dflgs) db hiddenPackages = Set.intersection hiddenPackageNames (Set.fromList packageNames) hiddenFlags = fmap HidePackage $ Set.toList hiddenPackages initStr = "ihaskell-"+#endif #if MIN_VERSION_ghc(8,2,0) -- Name of the ihaskell package, i.e. "ihaskell"@@ -351,10 +396,13 @@ updated <- case errs of -- Only run things if there are no parse errors. [] -> do++#ifdef USE_HLINT when (getLintStatus kernelState /= LintOff) $ liftIO $ do lintSuggestions <- lint code cmds unless (noResults lintSuggestions) $ output (FinalResult lintSuggestions [] []) Success+#endif runUntilFailure kernelState (map unloc cmds ++ [storeItCommand execCount]) -- Print all parse errors.@@ -385,9 +433,9 @@ Left err -> error $ "Deserialization error (Evaluate.hs): " ++ err Right displaysIO -> do result <- liftIO displaysIO- case Serialize.decode result of- Left err -> error $ "Deserialization error (Evaluate.hs): " ++ err- Right res -> return res+ case Binary.decodeOrFail result of+ Left (_, _, err) -> error $ "Deserialization error (Evaluate.hs): " ++ err+ Right (_, _, res) -> return res else return Nothing let result = case dispsMay of@@ -458,9 +506,13 @@ let commMessages = evalmsgs ++ messages widgetHandler state commMessages -+#if MIN_VERSION_ghc(9,2,0)+getErrMsgDoc :: ErrUtils.WarnMsg -> SDoc+getErrMsgDoc = ErrUtils.pprLocMsgEnvelope+#else getErrMsgDoc :: ErrUtils.ErrMsg -> SDoc getErrMsgDoc = ErrUtils.pprLocErrMsg+#endif safely :: KernelState -> Interpreter EvalOut -> Interpreter EvalOut safely state = ghandle handler . ghandle sourceErrorHandler@@ -677,6 +729,15 @@ let typeStr = showSDocUnqual flags $ ppr kind return $ formatType $ expr ++ " :: " ++ typeStr +evalCommand _ (Directive GetKindBang expr) state = wrapExecution state $ do+ write state $ "Kind!: " ++ expr+ (typ, kind) <- GHC.typeKind True expr+ flags <- getSessionDynFlags+ let kindStr = text expr <+> dcolon <+> ppr kind+ let typeStr = equals <+> ppr typ+ let finalStr = showSDocUnqual flags $ vcat [kindStr, typeStr]+ return $ formatType finalStr+ evalCommand _ (Directive LoadFile names) state = wrapExecution state $ do write state $ "Load: " ++ names @@ -689,6 +750,8 @@ doLoadModule filename modName return (ManyDisplay displays) +evalCommand _ (Directive Reload _) state = wrapExecution state doReload+ evalCommand publish (Directive ShellCmd cmd) state = wrapExecution state $ -- Assume the first character of 'cmd' is '!'. case words $ drop 1 cmd of@@ -845,9 +908,16 @@ #else let action = \_dflags _sev _srcspan _ppr _style msg -> modifyIORef' contents (showSDoc flags msg :) #endif+#if MIN_VERSION_ghc(9,2,0)+ pushLogHookM (const action)+#else let flags' = flags { log_action = action } _ <- setSessionDynFlags flags'+#endif Debugger.pprintClosureCommand False False binding+#if MIN_VERSION_ghc(9,2,0)+ popLogHookM+#endif _ <- setSessionDynFlags flags sprint <- liftIO $ readIORef contents return $ formatType (unlines sprint)@@ -971,9 +1041,9 @@ Nothing -> error "Expecting lazy Bytestring" Just bytestringIO -> do bytestring <- liftIO bytestringIO- case Serialize.decode bytestring of- Left err -> error err- Right disp ->+ case Binary.decodeOrFail bytestring of+ Left (_, _, err) -> error err+ Right (_, _, disp) -> return $ if useSvg state then disp :: Display@@ -1083,13 +1153,21 @@ -- Compile loaded modules. flags <- getSessionDynFlags errRef <- liftIO $ newIORef []+#if MIN_VERSION_ghc(9,0,0)+ let logAction = \_dflags _warn _sev _srcspan msg -> modifyIORef' errRef (showSDoc flags msg :)+#else+ let logAction = \_dflags _sev _srcspan _ppr _style msg -> modifyIORef' errRef (showSDoc flags msg :)+#endif+#if MIN_VERSION_ghc(9,2,0)+ pushLogHookM (const logAction)+#endif _ <- setSessionDynFlags $ flip gopt_set Opt_BuildDynamicToo flags- { hscTarget = objTarget flags-#if MIN_VERSION_ghc(9,0,0)- , log_action = \_dflags _warn _sev _srcspan msg -> modifyIORef' errRef (showSDoc flags msg :)+#if MIN_VERSION_ghc(9,2,0)+ { backend = objTarget flags #else- , log_action = \_dflags _sev _srcspan _ppr _style msg -> modifyIORef' errRef (showSDoc flags msg :)+ { hscTarget = objTarget flags+ , log_action = logAction #endif } @@ -1117,6 +1195,9 @@ -- Switch back to interpreted mode. _ <- setSessionDynFlags flags+#if MIN_VERSION_ghc(9,2,0)+ popLogHookM+#endif case result of Succeeded -> return mempty@@ -1134,7 +1215,11 @@ -- Switch to interpreted mode! flags <- getSessionDynFlags+#if MIN_VERSION_ghc(9,2,0)+ _ <- setSessionDynFlags flags { backend = Interpreter }+#else _ <- setSessionDynFlags flags { hscTarget = HscInterpreted }+#endif -- Return to old context, make sure we have `it`. setContext imported@@ -1142,10 +1227,82 @@ return $ displayError $ "Failed to load module " ++ modName ++ ": " ++ show exception +doReload :: Ghc Display+doReload = do+ -- Remember which modules we've loaded before.+ importedModules <- getContext++ flip gcatch (unload importedModules) $ do+ -- Compile loaded modules.+ flags <- getSessionDynFlags+ errRef <- liftIO $ newIORef []+ _ <- setSessionDynFlags $ flip gopt_set Opt_BuildDynamicToo+ flags+#if MIN_VERSION_ghc(9,2,0)+ { backend = objTarget flags+#elif MIN_VERSION_ghc(9,0,0)+ { hscTarget = objTarget flags+ , log_action = \_dflags _warn _sev _srcspan msg -> modifyIORef' errRef (showSDoc flags msg :)+#else+ { hscTarget = objTarget flags+ , log_action = \_dflags _sev _srcspan _ppr _style msg -> modifyIORef' errRef (showSDoc flags msg :)+#endif+ }++ -- Store the old targets in case of failure.+ oldTargets <- getTargets+ result <- load LoadAllTargets++ -- Reset the context, since loading things screws it up.+ initializeItVariable++ -- Reset targets if we failed.+ case result of+ Failed -> setTargets oldTargets+ Succeeded{} -> return ()++ -- Add imports+ setContext importedModules++ -- Switch back to interpreted mode.+ _ <- setSessionDynFlags flags++ case result of+ Succeeded -> return mempty+ Failed -> do+ errorStrs <- unlines <$> reverse <$> liftIO (readIORef errRef)+ return $ displayError $ "Failed to reload.\n" ++ errorStrs++ where+ unload :: [InteractiveImport] -> SomeException -> Ghc Display+ unload imported exception = do+ print $ show exception+ -- Explicitly clear targets+ setTargets []+ _ <- load LoadAllTargets++ -- Switch to interpreted mode!+ flags <- getSessionDynFlags+#if MIN_VERSION_ghc(9,2,0)+ _ <- setSessionDynFlags flags { backend = Interpreter }+#else+ _ <- setSessionDynFlags flags { hscTarget = HscInterpreted }+#endif++ -- Return to old context, make sure we have `it`.+ setContext imported+ initializeItVariable++ return $ displayError $ "Failed to reload."++#if MIN_VERSION_ghc(9,2,0)+objTarget :: DynFlags -> Backend+objTarget = platformDefaultBackend . targetPlatform+#elif MIN_VERSION_ghc(8,10,0) objTarget :: DynFlags -> HscTarget-#if MIN_VERSION_ghc(8,10,0) objTarget = defaultObjectTarget #else+objTarget :: DynFlags -> HscTarget objTarget flags = defaultObjectTarget $ targetPlatform flags #endif
src/IHaskell/Eval/Hoogle.hs view
@@ -14,7 +14,6 @@ import qualified Data.ByteString.Char8 as CBS import qualified Data.ByteString.Lazy as LBS-import Data.Either (either) import IHaskellPrelude import Data.Aeson
src/IHaskell/Eval/Info.hs view
@@ -8,7 +8,10 @@ import IHaskell.Eval.Evaluate (typeCleaner, Interpreter) import GHC-#if MIN_VERSION_ghc(9,0,0)+#if MIN_VERSION_ghc(9,2,0)+import GHC.Driver.Ppr+import Control.Monad.Catch (handle)+#elif MIN_VERSION_ghc(9,0,0) import GHC.Utils.Outputable import Control.Monad.Catch (handle) #else
src/IHaskell/Eval/Lint.hs view
@@ -83,7 +83,8 @@ autoSettings' = do (fixts, classify, hints) <- autoSettings let hidingIgnore = Classify Ignore "Unnecessary hiding" "" ""- return (fixts, hidingIgnore:classify, hints)+ let pragmaIgnore = Classify Ignore "Unused LANGUAGE pragma" "" ""+ return (fixts, pragmaIgnore:hidingIgnore:classify, hints) ignoredIdea idea = ideaSeverity idea == Ignore #else@@ -115,7 +116,8 @@ autoSettings' = do (fixts, classify, hints) <- autoSettings let hidingIgnore = Classify Ignore "Unnecessary hiding" "" ""- return (fixts, hidingIgnore:classify, hints)+ let pragmaIgnore = Classify Ignore "Unused LANGUAGE pragma" "" ""+ return (fixts, pragmaIgnore:hidingIgnore:classify, hints) ignoredIdea idea = ideaSeverity idea == Ignore createModule :: ParseMode -> Located CodeBlock -> Maybe ExtsModule
src/IHaskell/Eval/Parser.hs view
@@ -20,7 +20,6 @@ import Data.Char (toLower) import Data.List (maximumBy, inits) import Prelude (head, tail)-import Control.Monad (msum) #if MIN_VERSION_ghc(8,4,0) import GHC hiding (Located, Parsed)@@ -62,8 +61,10 @@ | SearchHoogle -- ^ Search for something via Hoogle. | GetDoc -- ^ Get documentation for an identifier via Hoogle. | GetKind -- ^ Get the kind of a type via ':kind'.+ | GetKindBang -- ^ Get the kind and normalised type via ':kind!'. | LoadModule -- ^ Load and unload modules via ':module'. | SPrint -- ^ Print without evaluating via ':sprint'.+ | Reload -- ^ Reload. deriving (Show, Eq) -- | Pragma types. Only LANGUAGE pragmas are currently supported. Other pragma types are kept around@@ -277,6 +278,7 @@ [ (LoadModule, "module") , (GetType, "type") , (GetKind, "kind")+ , (GetKindBang, "kind!") , (GetInfo, "info") , (SearchHoogle, "hoogle") , (GetDoc, "documentation")@@ -286,6 +288,7 @@ , (SetExtension, "extension") , (GetHelp, "?") , (GetHelp, "help")+ , (Reload, "reload") , (SPrint, "sprint") ] parseDirective _ _ = error "Directive must start with colon!"
src/IHaskell/Eval/Util.hs view
@@ -33,9 +33,26 @@ #endif -- GHC imports.-#if MIN_VERSION_ghc(9,0,0)+#if MIN_VERSION_ghc(9,2,0) import GHC.Core.InstEnv (is_cls, is_tys) import GHC.Core.Unify+import GHC.Types.TyThing.Ppr+import GHC.Driver.CmdLine+import GHC.Driver.Monad (modifySession)+import GHC.Driver.Ppr+import GHC.Driver.Session+import GHC.Driver.Env.Types+import GHC.Runtime.Context+import GHC.Types.Name (pprInfixName)+import GHC.Types.Name.Set+import GHC.Types.TyThing+import qualified GHC.Driver.Session as DynFlags+import qualified GHC.Utils.Outputable as O+import qualified GHC.Utils.Ppr as Pretty+import GHC.Runtime.Loader+#elif MIN_VERSION_ghc(9,0,0)+import GHC.Core.InstEnv (is_cls, is_tys)+import GHC.Core.Unify import GHC.Core.Ppr.TyThing import GHC.Driver.CmdLine import GHC.Driver.Monad (modifySession)@@ -46,6 +63,7 @@ import qualified GHC.Driver.Session as DynFlags import qualified GHC.Utils.Outputable as O import qualified GHC.Utils.Ppr as Pretty+import GHC.Runtime.Loader #else import DynFlags import GhcMonad@@ -57,17 +75,16 @@ import Unify (tcMatchTys) import qualified Pretty import qualified Outputable as O+#if MIN_VERSION_ghc(8,6,0)+import DynamicLoading #endif+#endif #if MIN_VERSION_ghc(8,6,0) #else import FastString #endif import GHC -import Control.Monad (void)-import Data.Function (on)-import Data.List (nubBy)- import StringUtils (replace) #if MIN_VERSION_ghc(9,0,0)@@ -218,13 +235,29 @@ setFlags ext = do -- Try to parse flags. flags <- getSessionDynFlags- (flags', unrecognized, warnings) <- parseDynamicFlags flags (map noLoc ext)+#if MIN_VERSION_ghc(9,2,0)+ logger <- getLogger+ (flags0, unrecognized, warnings) <- parseDynamicFlags logger flags (map noLoc ext)+#else+ (flags0, unrecognized, warnings) <- parseDynamicFlags flags (map noLoc ext)+#endif - -- First, try to check if this flag matches any extension name.- let restoredPkgs = flags' { packageFlags = packageFlags flags }- _ <- GHC.setProgramDynFlags restoredPkgs- GHC.setInteractiveDynFlags restoredPkgs+ -- We can't update packages here+ let flags1 = flags0 { packageFlags = packageFlags flags } +#if MIN_VERSION_ghc(9,2,0)+ -- Loading plugins explicitly is no longer required in 9.2+ let flags2 = flags1+#elif MIN_VERSION_ghc(8,6,0)+ -- Plugins were introduced in 8.6+ hsc_env <- GHC.getSession+ flags2 <- liftIO (initializePlugins hsc_env flags1)+#else+ let flags2 = flags1+#endif+ _ <- GHC.setProgramDynFlags flags2+ GHC.setInteractiveDynFlags flags2+ -- Create the parse errors. let noParseErrs = map (("Could not parse: " ++) . unLoc) unrecognized #if MIN_VERSION_ghc(8,4,0)@@ -232,7 +265,7 @@ #else allWarns = map unLoc warnings ++ #endif- ["-package not supported yet" | packageFlags flags /= packageFlags flags']+ ["-package not supported yet" | packageFlags flags /= packageFlags flags0] warnErrs = map ("Warning: " ++) allWarns return $ noParseErrs ++ warnErrs @@ -252,8 +285,13 @@ let style = O.mkUserStyle unqual O.AllTheWay #endif let cols = pprCols flags+#if MIN_VERSION_ghc(9,2,0)+ d = O.runSDoc sdoc (initSDocContext flags style)+ return $ Pretty.fullRender (Pretty.PageMode False) cols 1.5 string_txt "" d+#else d = O.runSDoc sdoc (O.initSDocContext flags style) return $ Pretty.fullRender Pretty.PageMode cols 1.5 string_txt "" d+#endif where string_txt :: Pretty.TextDetails -> String -> String@@ -279,7 +317,18 @@ initGhci :: GhcMonad m => Maybe String -> m () initGhci sandboxPackages = do -- Initialize dyn flags. Start with -XExtendedDefaultRules and -XNoMonomorphismRestriction.+#if MIN_VERSION_ghc(9,2,0)+ -- We start handling GHC environment files+ originalFlagsNoPackageEnv <- getSessionDynFlags+ logger <- getLogger+ originalFlags <- liftIO $ interpretPackageEnv logger originalFlagsNoPackageEnv+#elif MIN_VERSION_ghc(9,0,0)+ -- We start handling GHC environment files+ originalFlagsNoPackageEnv <- getSessionDynFlags+ originalFlags <- liftIO $ interpretPackageEnv originalFlagsNoPackageEnv+#else originalFlags <- getSessionDynFlags+#endif let flag = flip xopt_set unflag = flip xopt_unset dflags = flag ExtendedDefaultRules . unflag MonomorphismRestriction $ originalFlags@@ -296,7 +345,11 @@ in packageDBFlags originalFlags ++ [pkg] void $ setSessionDynFlags $ dflags+#if MIN_VERSION_ghc(9,2,0)+ { backend = Interpreter+#else { hscTarget = HscInterpreted+#endif , ghcLink = LinkInMemory , pprCols = 300 , packageDBFlags = pkgFlags@@ -388,7 +441,11 @@ names <- runDecls decl cleanUpDuplicateInstances flags <- getSessionDynFlags+#if MIN_VERSION_ghc(9,2,0)+ return $ map (replace ":Interactive." "" . showPpr flags) names+#else return $ map (replace ":Interactive." "" . O.showPpr flags) names+#endif cleanUpDuplicateInstances :: GhcMonad m => m () cleanUpDuplicateInstances = modifySession $ \hscEnv ->@@ -415,7 +472,11 @@ result <- exprType expr #endif flags <- getSessionDynFlags+#if MIN_VERSION_ghc(9,2,0)+ let typeStr = showSDoc flags $ O.ppr result+#else let typeStr = O.showSDocUnqual flags $ O.ppr result+#endif return typeStr -- | This is unfoldM from monad-loops. It repeatedly runs an IO action until it return Nothing, and
src/IHaskell/Eval/Widgets.hs view
@@ -1,4 +1,4 @@-{-# language NoImplicitPrelude, DoAndIfThenElse, OverloadedStrings, ExtendedDefaultRules #-}+{-# language NoImplicitPrelude, DoAndIfThenElse, OverloadedStrings, ExtendedDefaultRules, CPP #-} module IHaskell.Eval.Widgets ( widgetSendOpen, widgetSendView,@@ -16,9 +16,12 @@ import Control.Concurrent.STM (atomically) import Control.Concurrent.STM.TChan-import Control.Monad (foldM) import Data.Aeson+import Data.ByteString.Base64 as B64 (decodeLenient) import qualified Data.Map as Map+import Data.Text.Encoding (encodeUtf8)++import Data.Foldable (foldl) import System.IO.Unsafe (unsafePerformIO) import IHaskell.Display@@ -26,6 +29,13 @@ import IHaskell.IPython.Types (showMessageType) import IHaskell.Types +#if MIN_VERSION_aeson(2,0,0)+import qualified Data.Aeson.KeyMap as KM (lookup,insert,delete)+import qualified Data.Aeson.Key as Key+#else+import qualified Data.HashMap.Strict as HM (lookup,insert,delete)+#endif+ -- All comm_open messages go here widgetMessages :: TChan WidgetMsg {-# NOINLINE widgetMessages #-}@@ -77,9 +87,9 @@ widgetPublishDisplay :: (IHaskellWidget a, IHaskellDisplay b) => a -> b -> IO () widgetPublishDisplay widget disp = display disp >>= queue . DispMsg (Widget widget) --- | Send a `clear_output` message as a [method .= custom] message-widgetClearOutput :: IHaskellWidget a => a -> Bool -> IO ()-widgetClearOutput widget w = queue $ ClrOutput (Widget widget) w+-- | Send a `clear_output` message+widgetClearOutput :: Bool -> IO ()+widgetClearOutput w = queue $ ClrOutput w -- | Handle a single widget message. Takes necessary actions according to the message type, such as -- opening comms, storing and updating widget representation in the kernel state etc.@@ -99,8 +109,12 @@ newComms = Map.insert uuid widget oldComms newState = state { openComms = newComms } + (newvalue,buffers,bp) = processBPs value $ getBufferPaths widget+ applyBuffers x = x {mhBuffers = buffers}+ content = object [ "state" .= newvalue, "buffer_paths" .= bp ]+ communicate val = do- head <- dupHeader replyHeader CommDataMessage+ head <- applyBuffers <$> dupHeader replyHeader CommDataMessage send $ CommData head uuid val -- If the widget is present, don't open it again.@@ -108,8 +122,9 @@ then return state else do -- Send the comm open, with the initial state- hdr <- dupHeader replyHeader CommOpenMessage- send $ CommOpen hdr target_name target_module uuid value+ hdr <- applyBuffers <$> dupHeader replyHeader CommOpenMessage+ let hdrV = setVersion hdr "2.0.0" -- Widget Messaging Protocol Version+ send $ CommOpen hdrV target_name target_module uuid content -- Send anything else the widget requires. open widget communicate@@ -134,7 +149,9 @@ View widget -> sendMessage widget (toJSON DisplayWidget) - Update widget value -> sendMessage widget (toJSON $ UpdateState value)+ Update widget value -> do+ let (newvalue,buffers,bp) = processBPs value $ getBufferPaths widget+ sendMessageHdr widget (toJSON $ UpdateState newvalue bp) (\h->h {mhBuffers=buffers}) Custom widget value -> sendMessage widget (toJSON $ CustomContent value) @@ -145,20 +162,21 @@ let dmsg = WidgetDisplay dispHeader $ unwrap disp sendMessage widget (toJSON $ CustomContent $ toJSON dmsg) - ClrOutput widget w -> do+ ClrOutput w -> do hdr <- dupHeader replyHeader ClearOutputMessage- let cmsg = WidgetClear hdr w- sendMessage widget (toJSON $ CustomContent $ toJSON cmsg)+ send $ ClearOutput hdr w+ return state where oldComms = openComms state- sendMessage widget value = do+ sendMessage widget value = sendMessageHdr widget value id+ sendMessageHdr widget value hdrf = do let uuid = getCommUUID widget present = isJust $ Map.lookup uuid oldComms -- If the widget is present, we send an update message on its comm. when present $ do- hdr <- dupHeader replyHeader CommDataMessage+ hdr <- hdrf <$> dupHeader replyHeader CommDataMessage send $ CommData hdr uuid value return state @@ -166,6 +184,49 @@ unwrap (ManyDisplay ds) = concatMap unwrap ds unwrap (Display ddatas) = ddatas + -- Removes the values that are buffers and puts them in the third value of the tuple+ -- The returned bufferpaths are the bufferpaths used+ processBPs :: Value -> [BufferPath] -> (Value, [ByteString], [BufferPath])+ -- Searching if the BufferPath key is in the Object is O(log n) or O(1) depending on implementation+ -- For this reason we fold on the bufferpaths+ processBPs val = foldl f (val,[],[])+ where+#if MIN_VERSION_aeson(2,0,0)+ nestedLookupRemove :: BufferPath -> Value -> (Value, Maybe Value)+ nestedLookupRemove [] v = (v,Just v)+ nestedLookupRemove [b] v =+ case v of+ Object o -> (Object $ KM.delete (Key.fromText b) o, KM.lookup (Key.fromText b) o)+ _ -> (v, Nothing)+ nestedLookupRemove (b:bp) v =+ case v of+ Object o -> maybe (v,Nothing) (upd . nestedLookupRemove bp) (KM.lookup (Key.fromText b) o)+ _ -> (v,Nothing)+ where upd :: (Value, Maybe Value) -> (Value, Maybe Value)+ upd (Object v', Just (Object u)) = (Object $ KM.insert (Key.fromText b) (Object u) v', Just $ Object u)+ upd r = r+#else+ nestedLookupRemove :: BufferPath -> Value -> (Value, Maybe Value)+ nestedLookupRemove [] v = (v,Just v)+ nestedLookupRemove [b] v =+ case v of+ Object o -> (Object $ HM.delete b o, HM.lookup b o)+ _ -> (v, Nothing)+ nestedLookupRemove (b:bp) v =+ case v of+ Object o -> maybe (v,Nothing) (upd . nestedLookupRemove bp) (HM.lookup b o)+ _ -> (v,Nothing)+ where upd :: (Value, Maybe Value) -> (Value, Maybe Value)+ upd (Object v', Just (Object u)) = (Object $ HM.insert b (Object u) v', Just $ Object u)+ upd r = r+#endif++ f :: (Value, [ByteString], [BufferPath]) -> BufferPath -> (Value, [ByteString], [BufferPath])+ f r@(v,bs,bps) bp =+ case nestedLookupRemove bp v of+ (newv, Just (String b)) -> (newv, B64.decodeLenient (encodeUtf8 b) : bs, bp:bps)+ _ -> r+ -- Override toJSON for PublishDisplayData for sending Display messages through [method .= custom] data WidgetDisplay = WidgetDisplay MessageHeader [DisplayData] @@ -174,14 +235,6 @@ let pbval = toJSON $ PublishDisplayData replyHeader ddata Nothing in toJSON $ IPythonMessage replyHeader pbval DisplayDataMessage --- Override toJSON for ClearOutput-data WidgetClear = WidgetClear MessageHeader Bool--instance ToJSON WidgetClear where- toJSON (WidgetClear replyHeader w) =- let clrVal = toJSON $ ClearOutput replyHeader w- in toJSON $ IPythonMessage replyHeader clrVal ClearOutputMessage- data IPythonMessage = IPythonMessage MessageHeader Value MessageType instance ToJSON IPythonMessage where@@ -189,7 +242,7 @@ object [ "header" .= replyHeader , "parent_header" .= str ""- , "metadata" .= str "{}"+ , "metadata" .= object [] , "content" .= val , "msg_type" .= (toJSON . showMessageType $ mtype) ]
src/IHaskell/Flags.hs view
@@ -39,6 +39,7 @@ | ConvertLhsStyle (LhsStyle String) | KernelspecInstallPrefix String | KernelspecUseStack+ | KernelspecEnvFile FilePath deriving (Eq, Show) data LhsStyle string =@@ -124,6 +125,14 @@ where addStack (Args md prev) = Args md (KernelspecUseStack : prev) +kernelEnvFileFlag :: Flag Args+kernelEnvFileFlag =+ flagReq+ ["env-file"]+ (store KernelspecEnvFile)+ "<file>"+ "Load environment from this file when kernel is installed"+ confFlag :: Flag Args confFlag = flagReq ["conf", "c"] (store ConfFile) "<rc.hs>" "File with commands to execute at start; replaces ~/.ihaskell/rc.hs."@@ -144,11 +153,11 @@ installKernelSpec :: Mode Args installKernelSpec = mode "install" (Args InstallKernelSpec []) "Install the Jupyter kernelspec." noArgs- [ghcLibFlag, ghcRTSFlag, kernelDebugFlag, confFlag, installPrefixFlag, helpFlag, kernelStackFlag]+ [ghcLibFlag, ghcRTSFlag, kernelDebugFlag, confFlag, installPrefixFlag, helpFlag, kernelStackFlag, kernelEnvFileFlag] kernel :: Mode Args kernel = mode "kernel" (Args (Kernel Nothing) []) "Invoke the IHaskell kernel." kernelArg- [ghcLibFlag, kernelDebugFlag, confFlag, kernelStackFlag, kernelCodeMirrorFlag]+ [ghcLibFlag, kernelDebugFlag, confFlag, kernelStackFlag, kernelEnvFileFlag, kernelCodeMirrorFlag] where kernelArg = flagArg update "<json-kernel-file>" update filename (Args _ flags) = Right $ Args (Kernel $ Just filename) flags
src/IHaskell/IPython.hs view
@@ -11,6 +11,7 @@ kernelName, KernelSpecOptions(..), defaultKernelSpecOptions,+ installLabextension, ) where import IHaskellPrelude@@ -43,6 +44,7 @@ , kernelSpecConfFile :: IO (Maybe String) -- ^ Filename of profile JSON file. , kernelSpecInstallPrefix :: Maybe String , kernelSpecUseStack :: Bool -- ^ Whether to use @stack@ environments.+ , kernelSpecEnvFile :: Maybe FilePath } defaultKernelSpecOptions :: KernelSpecOptions@@ -55,6 +57,7 @@ , kernelSpecConfFile = defaultConfFile , kernelSpecInstallPrefix = Nothing , kernelSpecUseStack = False+ , kernelSpecEnvFile = Nothing } -- | The IPython kernel name.@@ -168,7 +171,33 @@ installPrefixFlag = maybe ["--user"] (\prefix -> ["--prefix", T.pack prefix]) (kernelSpecInstallPrefix opts) cmd = concat [["kernelspec", "install"], installPrefixFlag, [SH.toTextIgnore kernelDir], replaceFlag] - SH.silently $ SH.run ipython cmd+ let transformOutput = if kernelSpecDebug opts then id else SH.silently+ transformOutput $ SH.run ipython cmd++installLabextension :: Bool -> IO ()+installLabextension debug = SH.shelly $ do+ -- Find the prebuilt extension directory+ ihaskellDataDir <- liftIO $ Paths.getDataDir+ let labextensionDataDir = ihaskellDataDir+ SH.</> ("jupyterlab-ihaskell" :: SH.FilePath)+ SH.</> ("labextension" :: SH.FilePath)++ -- Find the $(jupyter --data-dir)/labextensions/jupyterlab-ihaskell directory+ jupyter <- locateIPython+ jupyterDataDir <- SH.silently $ SH.fromText . T.strip <$> SH.run jupyter ["--data-dir"]+ let jupyterlabIHaskellDir = jupyterDataDir+ SH.</> ("labextensions" :: SH.FilePath)+ SH.</> ("jupyterlab-ihaskell" :: SH.FilePath)++ when debug (putStrLn $ "Installing kernel in folder: " ++ show jupyterlabIHaskellDir)+ -- Remove the extension directory with extreme prejudice if it already exists+ SH.rm_rf jupyterlabIHaskellDir+ -- Create an empty 'jupyterlab-ihaskell' directory to install our extension in+ SH.mkdir_p jupyterlabIHaskellDir+ -- Copy the prebuilt extension files over+ extensionContents <- SH.ls labextensionDataDir+ forM_ extensionContents $ \entry ->+ SH.cp_r entry jupyterlabIHaskellDir -- | Replace "~" with $HOME if $HOME is defined. Otherwise, do nothing. subHome :: String -> IO String
src/IHaskell/Types.hs view
@@ -4,6 +4,7 @@ {-# LANGUAGE ExistentialQuantification #-} {-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE CPP #-} -- | Description : All message type definitions. module IHaskell.Types (@@ -11,8 +12,10 @@ MessageHeader(..), MessageType(..), dupHeader,+ setVersion, Username, Metadata,+ BufferPath, replyType, ExecutionState(..), StreamType(..),@@ -41,13 +44,20 @@ import IHaskellPrelude -import Data.Aeson (ToJSON (..), Value, (.=), object)+import Data.Aeson (ToJSON (..), Value, (.=), object, Value(String)) import Data.Function (on)-import Data.Serialize+import Data.Text (pack)+import Data.Binary import GHC.Generics import IHaskell.IPython.Kernel +#if MIN_VERSION_aeson(2,0,0)+import qualified Data.Aeson.KeyMap as KeyMap+#else+import qualified Data.HashMap.Strict as HashMap+#endif+ -- | A class for displayable Haskell types. -- -- IHaskell's displaying of results behaves as if these two overlapping/undecidable instances also@@ -58,6 +68,11 @@ class IHaskellDisplay a where display :: a -> IO Display +type BufferPath = [Text]++emptyBPs :: [BufferPath]+emptyBPs = []+ -- | Display as an interactive widget. class IHaskellDisplay a => IHaskellWidget a where -- | Target name for this widget. The actual input parameter should be ignored. By default evaluate@@ -69,6 +84,10 @@ targetModule :: a -> String targetModule _ = "" + -- | Buffer paths for this widget. Evaluates to an empty array by default.+ getBufferPaths :: a -> [BufferPath]+ getBufferPaths _ = emptyBPs+ -- | Get the uuid for comm associated with this widget. The widget is responsible for storing the -- UUID during initialization. getCommUUID :: a -> UUID@@ -124,6 +143,7 @@ instance IHaskellWidget Widget where targetName (Widget widget) = targetName widget targetModule (Widget widget) = targetModule widget+ getBufferPaths (Widget widget) = getBufferPaths widget getCommUUID (Widget widget) = getCommUUID widget open (Widget widget) = open widget comm (Widget widget) = comm widget@@ -141,8 +161,12 @@ | ManyDisplay [Display] deriving (Show, Typeable, Generic) -instance Serialize Display+instance ToJSON Display where+ toJSON (Display d) = object (map displayDataToJson d)+ toJSON (ManyDisplay d) = toJSON d +instance Binary Display+ instance Semigroup Display where ManyDisplay a <> ManyDisplay b = ManyDisplay (a ++ b) ManyDisplay a <> b = ManyDisplay (a ++ [b])@@ -236,17 +260,17 @@ DispMsg Widget Display | -- ^ A 'display_data' message, sent as a [method .= custom] comm_msg- ClrOutput Widget Bool- -- ^ A 'clear_output' message, sent as a [method .= custom] comm_msg+ ClrOutput Bool+ -- ^ A 'clear_output' message, sent as a clear_output message deriving (Show, Typeable) -data WidgetMethod = UpdateState Value+data WidgetMethod = UpdateState Value [BufferPath] | CustomContent Value | DisplayWidget instance ToJSON WidgetMethod where toJSON DisplayWidget = object ["method" .= ("display" :: Text)]- toJSON (UpdateState v) = object ["method" .= ("update" :: Text), "state" .= v]+ toJSON (UpdateState v bp) = object ["method" .= ("update" :: Text), "state" .= v, "buffer_paths" .= bp] toJSON (CustomContent v) = object ["method" .= ("custom" :: Text), "content" .= v] -- | Output of evaluation.@@ -276,6 +300,20 @@ dupHeader hdr messageType = do uuid <- liftIO random return hdr { mhMessageId = uuid, mhMsgType = messageType }++-- | Modifies a header and appends the version of the Widget Messaging Protocol as metadata+setVersion :: MessageHeader -- ^ The header to modify+ -> String -- ^ The version to set+ -> MessageHeader -- ^ The modified header++-- We use the 'fromList' function from "Data.HashMap.Strict" (or+-- "Data.Aeson.KeyMap") instead of the 'object' function from "Data.Aeson"+-- because 'object' returns a 'Value', but metadata needs an 'Object'.+#if MIN_VERSION_aeson(2,0,0)+setVersion hdr v = hdr { mhMetadata = Metadata (KeyMap.fromList [("version", String $ pack v)]) }+#else+setVersion hdr v = hdr { mhMetadata = Metadata (HashMap.fromList [("version", String $ pack v)]) }+#endif -- | Whether or not an error occurred. data ErrorOccurred = Success
src/tests/IHaskell/Test/Completion.hs view
@@ -14,8 +14,13 @@ import System.Environment (setEnv) import System.Directory (setCurrentDirectory, getCurrentDirectory) +#if MIN_VERSION_ghc(9,2,0) import GHC (getSessionDynFlags, setSessionDynFlags, DynFlags(..), GhcLink(..), setContext,+ parseImportDecl, Backend(..), InteractiveImport(..))+#else+import GHC (getSessionDynFlags, setSessionDynFlags, DynFlags(..), GhcLink(..), setContext, parseImportDecl, HscTarget(..), InteractiveImport(..))+#endif import Test.Hspec @@ -61,7 +66,11 @@ initCompleter :: Interpreter () initCompleter = do flags <- getSessionDynFlags+#if MIN_VERSION_ghc(9,2,0)+ _ <- setSessionDynFlags $ flags { backend = Interpreter, ghcLink = LinkInMemory }+#else _ <- setSessionDynFlags $ flags { hscTarget = HscInterpreted, ghcLink = LinkInMemory }+#endif -- Import modules. imports <- mapM parseImportDecl
src/tests/IHaskell/Test/Eval.hs view
@@ -161,7 +161,10 @@ ":! printf \"hello\\nworld\"" `becomes` ["hello\nworld"] it "evaluates directives" $ do-#if MIN_VERSION_ghc(9,0,0)+#if MIN_VERSION_ghc(9,2,0)+ -- It's `a` instead of `p`+ ":typ 3" `becomes` ["3 :: forall {a}. Num a => a"]+#elif MIN_VERSION_ghc(9,0,0) -- brackets around the type variable ":typ 3" `becomes` ["3 :: forall {p}. Num p => p"] #elif MIN_VERSION_ghc(8,2,0)
src/tests/IHaskell/Test/Parser.hs view
@@ -232,7 +232,9 @@ #else dataKindsError = ParseError (Loc 1 10) msg #endif-#if MIN_VERSION_ghc(8,8,0)+#if MIN_VERSION_ghc(9,2,0)+ msg = "Cannot parse data constructor in a data/newtype declaration: 3"+#elif MIN_VERSION_ghc(8,8,0) msg = "Cannot parse data constructor in a data/newtype declaration:\n 3" #else msg = "Cannot parse data constructor in a data/newtype declaration: 3"