content: {-# LANGUAGE NoImplicitPrelude, OverloadedStrings #-}
  {-# LANGUAGE ScopedTypeVariables #-}
  {-# LANGUAGE CPP #-}
  
  module IHaskell.Convert.IpynbToLhs (ipynbToLhs) where
  
  import           IHaskellPrelude
  import qualified Data.Text.Lazy as LT
  import qualified Data.ByteString.Lazy as LBS
  
  import           Data.Aeson (decode, Object, Value(Array, Object, String))
  import           Data.Vector (Vector)
  
  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
             -> FilePath -- ^ the filename of the literate haskell to write
             -> IO ()
  ipynbToLhs sty from to = do
    Just (js :: Object) <- decode <$> LBS.readFile from
    case lookup "cells" js of
      Just (Array cells) ->
        LTIO.writeFile to $ LT.unlines $ V.toList $ V.map (\(Object y) -> convCell sty y) cells
      _ -> error "IHaskell.Convert.ipynbTolhs: json does not follow expected schema"
  
  concatWithPrefix :: LT.Text -- ^ the prefix to add to every line
                   -> Vector Value          -- ^ a json array of text lines
                   -> Maybe LT.Text
  concatWithPrefix p arr = LT.concat . map (p <>) . V.toList <$> V.mapM toStr arr
  
  toStr :: Value -> Maybe LT.Text
  toStr (String x) = Just (LT.fromStrict x)
  toStr _ = Nothing
  
  -- | @convCell sty cell@ converts a single cell in JSON into text suitable for the type of lhs file
  -- described by the @sty@
  convCell :: LhsStyle LT.Text -> Object -> LT.Text
  convCell _sty object
    | Just (String "markdown") <- lookup "cell_type" object,
      Just (Array xs) <- lookup "source" object,
      ~(Just s) <- concatWithPrefix "" xs
    = s
  convCell sty object
    | Just (String "code") <- lookup "cell_type" object,
      Just (Array a) <- lookup "source" object,
      Just (Array o) <- lookup "outputs" object,
      ~(Just i) <- concatWithPrefix (lhsCodePrefix sty) a,
      o2 <- fromMaybe mempty (convOutputs sty o)
    = "\n" <>
      lhsBeginCode sty <> i <> lhsEndCode sty <> "\n" <> o2 <> "\n"
  convCell _ _ = "IHaskell.Convert.convCell: unknown cell"
  
  convOutputs :: LhsStyle LT.Text
              -> Vector Value -- ^ JSON array of output lines containing text or markup
              -> Maybe LT.Text
  convOutputs sty array = do
    outputLines <- V.mapM (getTexts (lhsOutputPrefix sty)) array
    return $ lhsBeginOutput sty <> LT.concat (V.toList outputLines) <> lhsEndOutput sty
  
  getTexts :: LT.Text -> Value -> Maybe LT.Text
  getTexts p (Object object)
    | Just (Array text) <- lookup "text" object = concatWithPrefix p text
  getTexts _ _ = Nothing
  