Adding `view` command to ihaskell

IHaskell/IPython.hs

@@ -6,11 +6,14 @@ module IHaskell.IPython (
   ipythonInstalled,
   installIPython,
   updateIPython,
+  setupIPython,
   runConsole,
   runNotebook,
   readInitInfo,
   defaultConfFile,
   getIHaskellDir,
+  nbconvert,
+  ViewFormat(..),
 ) where
 
 import ClassyPrelude
@@ -23,12 +26,43 @@ import Data.List.Utils (split)
 import Data.String.Utils (rstrip)
 import Text.Printf
 
+import Text.Read as Read hiding (pfail)
+import Text.ParserCombinators.ReadP
+
 import qualified System.IO.Strict as StrictIO
 import qualified Paths_ihaskell as Paths
 import qualified Codec.Archive.Tar as Tar
 
 import IHaskell.Types
 
+data ViewFormat
+     = Pdf
+     | Html
+     | Ipynb
+     | Markdown
+     | Latex
+     deriving Eq
+
+instance Show ViewFormat where
+  show Pdf         = "pdf"
+  show Html        = "html"
+  show Ipynb       = "ipynb"
+  show Markdown    = "markdown"
+  show Latex       = "latex"
+
+instance Read ViewFormat where
+  readPrec = Read.lift $ do
+    str <- munch (const True)
+    case str of
+      "pdf" -> return Pdf
+      "html" -> return Html
+      "ipynb" -> return Ipynb
+      "notebook" -> return Ipynb
+      "latex" -> return Latex
+      "markdown" -> return Markdown
+      "md" -> return Markdown
+      _ -> pfail
+
 -- | Which commit of IPython we are on.
 ipythonCommit :: Text
 ipythonCommit = "0fc2a30eb582f431c96fb44e9e8691806b82234b"
@@ -95,6 +129,41 @@ defaultConfFile = shellyNoDir $ do
            then Just $ fpToString filename
            else Nothing
 
+-- | Find a notebook and then convert it into the provided format.
+-- Notebooks are searched in the current directory as well as the IHaskell
+-- notebook directory (in that order).
+nbconvert :: ViewFormat -> String -> IO ()
+nbconvert fmt name = void . shellyNoDir $ do
+  curdir <- pwd
+  nbdir <- notebookDir
+  -- Find which of the options is available. 
+  let notebookOptions = [
+        curdir </> fpFromString name,
+        curdir </> fpFromString (name ++ ".ipynb"),
+        nbdir  </> fpFromString name,
+        nbdir  </> fpFromString (name ++ ".ipynb")
+        ]
+  maybeNb <- headMay <$> filterM test_f notebookOptions
+  case maybeNb of
+    Nothing -> do
+      putStrLn $ "Cannot find notebook: " ++ pack name
+      putStrLn "Tried:"
+      mapM_ (putStrLn . ("  " ++) . fpToText) notebookOptions 
+
+    Just notebook ->
+      let viewArgs = case fmt of
+            Pdf -> ["--to=latex", "--post=pdf"]
+            fmt -> ["--to=" ++ show fmt] in
+      void $ runIHaskell ipythonProfile "nbconvert" $ viewArgs ++ [fpToString notebook]
+
+-- | Set up IPython properly.
+setupIPython :: IO ()
+setupIPython = do
+  installed <- ipythonInstalled
+  if installed
+  then updateIPython
+  else installIPython
+
 -- | Update the IPython source tree and rebuild.
 updateIPython :: IO ()
 updateIPython = void . shellyNoDir $ do

Main.hs

@@ -47,6 +47,7 @@ data IHaskellMode
   | Console
   | UpdateIPython
   | Kernel (Maybe String)
+  | View (Maybe ViewFormat) (Maybe String)
   deriving (Eq, Show)
 
 main ::  IO ()
@@ -85,12 +86,40 @@ kernel = mode "kernel" (Args (Kernel Nothing) []) "Invoke the IHaskell kernel."
 update :: Mode Args
 update = mode "update" (Args UpdateIPython []) "Update IPython frontends." noArgs []
 
+view :: Mode Args
+view = (modeEmpty $ Args (View Nothing Nothing) []) {
+      modeNames = ["view"],
+      modeCheck  =
+        \a@(Args (View fmt file) _) ->
+          if not (isJust fmt && isJust file)
+          then Left "Syntax: IHaskell view <format> <name>[.ipynb]"
+          else Right a,
+      modeHelp = concat [
+        "Convert an IHaskell notebook to another format.\n",
+        "Notebooks are searched in the IHaskell directory and the current directory.\n",
+        "Available formats are " ++ intercalate ", " (map show 
+          ["pdf", "html", "ipynb", "markdown", "latex"]),
+        "."
+      ],
+      modeArgs = ([formatArg, filenameArg], Nothing)
+                                                    
+  }
+  where
+    formatArg = flagArg updateFmt "<format>"
+    filenameArg = flagArg updateFile "<name>[.ipynb]"
+    updateFmt fmtStr (Args (View _ s) flags) = 
+      case readMay fmtStr of
+        Just fmt -> Right $ Args (View (Just fmt) s) flags
+        Nothing -> Left $ "Invalid format '" ++ fmtStr ++ "'."
+    updateFile name (Args (View f _) flags) = Right $ Args (View f (Just name)) flags
+  
+
 ihaskellArgs :: Mode Args
 ihaskellArgs =
-  let descr = "IHaskell: Haskell for Interactive Computing." 
+  let descr = "Haskell for Interactive Computing." 
       onlyHelp = [flagHelpSimple (add Help)]
       noMode = mode "IHaskell" (Args None []) descr noArgs onlyHelp in
-    noMode { modeGroupModes = toGroup [console, notebook, update, kernel] }
+    noMode { modeGroupModes = toGroup [console, notebook, view, update, kernel] }
   where 
     add flag (Args mode flags) = Args mode $ flag : flags
 
@@ -108,24 +137,21 @@ ihaskell (Args None _) =
 -- isn't updated. This is hard to detect since versions of IPython might
 -- not change!
 ihaskell (Args UpdateIPython _) = do
-  updateIPython
+  setupIPython
   putStrLn "IPython updated."
     
 ihaskell (Args Console flags) = showingHelp Console flags $ do
-  installed <- ipythonInstalled
-  if installed
-  then updateIPython
-  else installIPython
+  setupIPython
 
   flags <- addDefaultConfFile flags
   info <- initInfo flags
   runConsole info
 
+ihaskell (Args (View (Just fmt) (Just name)) []) =
+  nbconvert fmt name
+
 ihaskell (Args Notebook flags) = showingHelp Notebook flags $ do
-  installed <- ipythonInstalled
-  if installed
-  then updateIPython
-  else installIPython
+  setupIPython
 
   let server = case mapMaybe serveDir flags of
                  [] -> Nothing

profile/ipython_config.py

@@ -4,3 +4,6 @@ c = get_config()
 c.KernelManager.kernel_cmd = [exe, 'kernel', '{connection_file}']
 c.Session.key = ''
 c.Session.keyfile = ''
+
+# Syntax highlight properly in Haskell notebooks. 
+c.NbConvertBase.default_language = "haskell"