-- | Defines helper functions for creating jupyter notebooks.
module Language.Drasil.JSON.Helpers where

import Prelude hiding ((<>))
import Text.PrettyPrint (Doc, text, empty, (<>), vcat, hcat)
import Data.List (intersperse)
import Data.List.Split (splitOn)

import Language.Drasil (MaxWidthPercent)
import qualified Language.Drasil.Printing.Helpers as H
import Language.Drasil.HTML.Helpers (img)
import Numeric (showHex)

data Variation = Class | Id

tr, td, figure, li, pa, ba :: Doc -> Doc
-- | Table row tag wrapper
tr :: Doc -> Doc
tr         = [Char] -> [[Char]] -> Doc -> Doc
wrap [Char]
"tr" []
-- | Table cell tag wrapper
td :: Doc -> Doc
td         = [Char] -> [[Char]] -> Doc -> Doc
wrap [Char]
"td" []
-- | Figure tag wrapper
figure :: Doc -> Doc
figure     = [Char] -> [[Char]] -> Doc -> Doc
wrap [Char]
"figure" []
-- | List tag wrapper
li :: Doc -> Doc
li         = [Char] -> [[Char]] -> Doc -> Doc
wrap' [Char]
"li" []
-- | Paragraph in list tag wrapper
pa :: Doc -> Doc
pa         = [Char] -> [[Char]] -> Doc -> Doc
wrap [Char]
"p" []
-- | Bring attention to element wrapper.
ba :: Doc -> Doc
ba         = [Char] -> [[Char]] -> Doc -> Doc
wrap [Char]
"b" []

ol, ul, table :: [String] -> Doc -> Doc
-- | Ordered list tag wrapper
ol :: [[Char]] -> Doc -> Doc
ol       = [Char] -> [[Char]] -> Doc -> Doc
wrap [Char]
"ol"
-- | Unordered list tag wrapper
ul :: [[Char]] -> Doc -> Doc
ul       = [Char] -> [[Char]] -> Doc -> Doc
wrap [Char]
"ul"
-- | Table tag wrapper
table :: [[Char]] -> Doc -> Doc
table    = [Char] -> [[Char]] -> Doc -> Doc
wrap [Char]
"table"

-- FIXME: Why are we using a Doc if we use 'show'?
nbformat :: Doc -> Doc
nbformat :: Doc -> Doc
nbformat Doc
s = [Char] -> Doc
text ([Char]
"    \"" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char] -> [Char]
escapeStringForJson (Doc -> [Char]
forall a. Show a => a -> [Char]
show Doc
s) [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"\\n\",")

-- TODO: This replaces the `json` library import, and is modelled after it:
-- https://www.stackage.org/haddock/lts-20.20/json-0.10/src/Text.JSON.String.html#encJSString
-- However, we should ultimately replace this with our own JSON encoding with
-- more printing options and using `Doc`s appropriately. Alternatively, if we
-- prefer to use a premade library, Aeson has more features, is actively
-- developed, and is already compiled by our other dependencies.
escapeStringForJson :: String -> String
escapeStringForJson :: [Char] -> [Char]
escapeStringForJson = (Char -> [Char]) -> [Char] -> [Char]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (([Char] -> [Char])
-> ([Char] -> [Char]) -> Either [Char] [Char] -> [Char]
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either [Char] -> [Char]
forall a. a -> a
id (Char
'\\' Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
:) (Either [Char] [Char] -> [Char])
-> (Char -> Either [Char] [Char]) -> Char -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Either [Char] [Char]
special)
  where
    special :: Char -> Either String String
    special :: Char -> Either [Char] [Char]
special Char
c
      | Char
c Char -> [Char] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Char]
"\"\\"       = [Char] -> Either [Char] [Char]
forall a b. b -> Either a b
Right [Char
c]
      | Char
c Char -> [Char] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Char]
"\b\f\n\r\t" = [Char] -> Either [Char] [Char]
forall a b. b -> Either a b
Right ([Char] -> [Char]
forall a. Show a => a -> [Char]
show [Char
c])
      -- note: the below double quotes disregard the point of ShowS, but that
      -- shouldn't be an issue if we switch to using `Doc`s.
      | Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
< Char
'\x20'            = [Char] -> Either [Char] [Char]
forall a b. b -> Either a b
Right (Int -> [Char] -> [Char]
forall a. Integral a => a -> [Char] -> [Char]
showHex (Char -> Int
forall a. Enum a => a -> Int
fromEnum Char
c) [Char]
"")
      | Bool
otherwise             = [Char] -> Either [Char] [Char]
forall a b. a -> Either a b
Left [Char
c]

codeformat :: Doc -> Doc
codeformat :: Doc -> Doc
codeformat Doc
s = [Char] -> Doc
text ([Char]
"    \"" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char] -> [Char]
escapeStringForJson (Doc -> [Char]
forall a. Show a => a -> [Char]
show Doc
s) [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"\\n\"")

wrap :: String -> [String] -> Doc -> Doc
wrap :: [Char] -> [[Char]] -> Doc -> Doc
wrap [Char]
a = ([Doc] -> Doc)
-> Variation -> [Char] -> Doc -> [[Char]] -> Doc -> Doc
wrapGen' [Doc] -> Doc
vcat Variation
Class [Char]
a Doc
empty

wrap' :: String -> [String] -> Doc -> Doc
wrap' :: [Char] -> [[Char]] -> Doc -> Doc
wrap' [Char]
a = ([Doc] -> Doc)
-> Variation -> [Char] -> Doc -> [[Char]] -> Doc -> Doc
wrapGen' [Doc] -> Doc
hcat Variation
Class [Char]
a Doc
empty

wrapGen' :: ([Doc] -> Doc) -> Variation -> String -> Doc -> [String] -> Doc -> Doc
wrapGen' :: ([Doc] -> Doc)
-> Variation -> [Char] -> Doc -> [[Char]] -> Doc -> Doc
wrapGen' [Doc] -> Doc
sepf Variation
_ [Char]
s Doc
_ [] = \Doc
x ->
  let tb :: [Char] -> Doc
tb [Char]
c = [Char] -> Doc
text ([Char] -> Doc) -> [Char] -> Doc
forall a b. (a -> b) -> a -> b
$ [Char]
"<" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
c [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
">"
  --in sepf [quote(tb s), x, quote(tb $ '/':s)]
  in if [Char]
s [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== [Char]
"li" then [Doc] -> Doc
sepf [[Char] -> Doc
tb [Char]
s, Doc
x, [Char] -> Doc
tb ([Char] -> Doc) -> [Char] -> Doc
forall a b. (a -> b) -> a -> b
$ Char
'/'Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
:[Char]
s] else [Doc] -> Doc
sepf [Doc -> Doc
nbformat ([Char] -> Doc
tb [Char]
s), Doc
x, Doc -> Doc
nbformat ([Char] -> Doc
tb ([Char] -> Doc) -> [Char] -> Doc
forall a b. (a -> b) -> a -> b
$ Char
'/'Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
:[Char]
s)]
wrapGen' [Doc] -> Doc
sepf Variation
Class [Char]
s Doc
_ [[Char]]
ts = \Doc
x ->
  let tb :: [Char] -> Doc
tb [Char]
c = [Char] -> Doc
text ([Char] -> Doc) -> [Char] -> Doc
forall a b. (a -> b) -> a -> b
$ [Char]
"<" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
c [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" class=\\\"" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ ([Char] -> [Char] -> [Char]) -> [[Char]] -> [Char]
forall a. (a -> a -> a) -> [a] -> a
forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldr1 [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
(++) ([Char] -> [[Char]] -> [[Char]]
forall a. a -> [a] -> [a]
intersperse [Char]
" " [[Char]]
ts) [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"\\\">"
  in let te :: [Char] -> Doc
te [Char]
c = [Char] -> Doc
text ([Char] -> Doc) -> [Char] -> Doc
forall a b. (a -> b) -> a -> b
$ [Char]
"</" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
c [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
">"
  in [Doc] -> Doc
sepf [Doc -> Doc
nbformat ([Char] -> Doc
tb [Char]
s), Doc
x, Doc -> Doc
nbformat ([Char] -> Doc
te [Char]
s)]
wrapGen' [Doc] -> Doc
sepf Variation
Id [Char]
s Doc
ti [[Char]]
_ = \Doc
x ->
  let tb :: [Char] -> Doc
tb [Char]
c = [Char] -> Doc
text ([Char]
"<" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
c [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" id=\\\"") Doc -> Doc -> Doc
<> Doc
ti Doc -> Doc -> Doc
<> [Char] -> Doc
text [Char]
"\\\">"
      te :: [Char] -> Doc
te [Char]
c = [Char] -> Doc
text ([Char] -> Doc) -> [Char] -> Doc
forall a b. (a -> b) -> a -> b
$ [Char]
"</" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
c [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
">"
  in  [Doc] -> Doc
sepf [Doc -> Doc
nbformat ([Char] -> Doc
tb [Char]
s), Doc
x, Doc -> Doc
nbformat ([Char] -> Doc
te [Char]
s)]

refwrap :: Doc -> Doc -> Doc
refwrap :: Doc -> Doc -> Doc
refwrap = (Doc -> [[Char]] -> Doc -> Doc) -> [[Char]] -> Doc -> Doc -> Doc
forall a b c. (a -> b -> c) -> b -> a -> c
flip (([Doc] -> Doc)
-> Variation -> [Char] -> Doc -> [[Char]] -> Doc -> Doc
wrapGen' [Doc] -> Doc
vcat Variation
Id [Char]
"div") [[Char]
""]

refID :: Doc -> Doc
refID :: Doc -> Doc
refID Doc
i = Doc -> Doc
nbformat (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ [Char] -> Doc
text [Char]
"<a id=\"" Doc -> Doc -> Doc
<> Doc
i Doc -> Doc -> Doc
<> [Char] -> Doc
text [Char]
"\"></a>"

-- | Helper for setting up links to references
reflink :: String -> Doc -> Doc
reflink :: [Char] -> Doc -> Doc
reflink [Char]
ref Doc
txt = [Char] -> Doc
text [Char]
"[" Doc -> Doc -> Doc
<> Doc
txt Doc -> Doc -> Doc
<> [Char] -> Doc
text ([Char]
"](#" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
ref [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
")")
--reflink ref txt = text ("<a href=#" ++ ref ++ ">") <> txt <> text "</a>"

-- | Helper for setting up links to external URIs
reflinkURI :: String -> Doc -> Doc
reflinkURI :: [Char] -> Doc -> Doc
reflinkURI [Char]
ref Doc
txt = [Char] -> Doc
text ([Char]
"<a href=\\\"" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
ref [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"\\\">") Doc -> Doc -> Doc
<> Doc
txt Doc -> Doc -> Doc
<> [Char] -> Doc
text [Char]
"</a>"

-- | Helper for setting up figures.
image :: Doc -> Maybe Doc -> MaxWidthPercent -> Doc
image :: Doc -> Maybe Doc -> MaxWidthPercent -> Doc
image Doc
f Maybe Doc
Nothing MaxWidthPercent
wp =
  Doc -> Doc
figure (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ [Doc] -> Doc
vcat [
  Doc -> Doc
nbformat (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ [([Char], Doc)] -> Doc
img ([([Char], Doc)] -> Doc) -> [([Char], Doc)] -> Doc
forall a b. (a -> b) -> a -> b
$ [([Char]
"src", Doc
f), ([Char]
"alt", [Char] -> Doc
text [Char]
"")] [([Char], Doc)] -> [([Char], Doc)] -> [([Char], Doc)]
forall a. [a] -> [a] -> [a]
++ [([Char]
"width", [Char] -> Doc
text ([Char] -> Doc) -> [Char] -> Doc
forall a b. (a -> b) -> a -> b
$ MaxWidthPercent -> [Char]
forall a. Show a => a -> [Char]
show MaxWidthPercent
wp [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"%") | MaxWidthPercent
wp MaxWidthPercent -> MaxWidthPercent -> Bool
forall a. Eq a => a -> a -> Bool
/= MaxWidthPercent
100]]
image Doc
f (Just Doc
c) MaxWidthPercent
wp =
  Doc -> Doc
figure (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ [Doc] -> Doc
vcat [
  Doc -> Doc
nbformat (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ [([Char], Doc)] -> Doc
img ([([Char], Doc)] -> Doc) -> [([Char], Doc)] -> Doc
forall a b. (a -> b) -> a -> b
$ [([Char]
"src", Doc
f), ([Char]
"alt", Doc
c)] [([Char], Doc)] -> [([Char], Doc)] -> [([Char], Doc)]
forall a. [a] -> [a] -> [a]
++ [([Char]
"width", [Char] -> Doc
text ([Char] -> Doc) -> [Char] -> Doc
forall a b. (a -> b) -> a -> b
$ MaxWidthPercent -> [Char]
forall a. Show a => a -> [Char]
show MaxWidthPercent
wp [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"%") | MaxWidthPercent
wp MaxWidthPercent -> MaxWidthPercent -> Bool
forall a. Eq a => a -> a -> Bool
/= MaxWidthPercent
100]]

h :: Int -> Doc
h :: Int -> Doc
h Int
n       | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
1 = [Char] -> Doc
forall a. HasCallStack => [Char] -> a
error [Char]
"Illegal header (too small)"
          | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
4 = [Char] -> Doc
forall a. HasCallStack => [Char] -> a
error [Char]
"Illegal header (too large)"
          | Bool
otherwise = [Char] -> Doc
text (Int -> [Char]
forall {a}. (Eq a, Num a) => a -> [Char]
hash Int
n)
              where hash :: a -> [Char]
hash a
1 = [Char]
"# "
                    hash a
2 = [Char]
"## "
                    hash a
3 = [Char]
"### "
                    hash a
4 = [Char]
"#### "
                    hash a
_ = [Char]
"Illegal header"

-- | Curly braces.
br :: Doc -> Doc
br :: Doc -> Doc
br Doc
x = [Char] -> Doc
text [Char]
"{" Doc -> Doc -> Doc
<> Doc
x Doc -> Doc -> Doc
<> [Char] -> Doc
text [Char]
"}"

mkDiv :: String -> Doc -> Doc -> Doc
mkDiv :: [Char] -> Doc -> Doc -> Doc
mkDiv [Char]
s Doc
a0 Doc
a1 = (Doc
H.bslash Doc -> Doc -> Doc
<> [Char] -> Doc
text [Char]
s) Doc -> Doc -> Doc
<> Doc -> Doc
br Doc
a0 Doc -> Doc -> Doc
<> Doc -> Doc
br Doc
a1

-- Maybe use "lines" instead (Data.List @lines :: String -> [String])
stripnewLine :: String -> Doc
stripnewLine :: [Char] -> Doc
stripnewLine [Char]
s = [Doc] -> Doc
hcat (([Char] -> Doc) -> [[Char]] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map [Char] -> Doc
text ([Char] -> [Char] -> [[Char]]
forall a. Eq a => [a] -> [a] -> [[a]]
splitOn [Char]
"\n" [Char]
s))

-- | Helper for building Markdown cells
markdownB, markdownB', markdownE, markdownE' :: Doc
markdownB :: Doc
markdownB  = [Char] -> Doc
text [Char]
"{\n \"cells\": [\n  {\n   \"cell_type\": \"markdown\",\n   \"metadata\": {},\n   \"source\": [\n" 
markdownB' :: Doc
markdownB' = [Char] -> Doc
text [Char]
"  {\n   \"cell_type\": \"markdown\",\n   \"metadata\": {},\n   \"source\": [\n" 
markdownE :: Doc
markdownE  = [Char] -> Doc
text [Char]
"    \"\\n\"\n   ]\n  },"
markdownE' :: Doc
markdownE' = [Char] -> Doc
text [Char]
"    \"\\n\"\n   ]\n  }\n ],"

-- | Helper for building code cells
codeB, codeE :: Doc
codeB :: Doc
codeB = [Char] -> Doc
text [Char]
"  {\n   \"cell_type\": \"code\",\n   \"execution_count\": null,\n   \"metadata\": {},\n   \"outputs\": [],\n   \"source\": [" 
codeE :: Doc
codeE  = [Char] -> Doc
text [Char]
"\n   ]\n  },"

-- | Helper for generate a Markdown cell
markdownCell :: Doc -> Doc
markdownCell :: Doc -> Doc
markdownCell Doc
c = Doc
markdownB' Doc -> Doc -> Doc
<> Doc
c Doc -> Doc -> Doc
<> Doc
markdownE

-- | Helper for generate a code cell
codeCell :: Doc -> Doc
codeCell :: Doc -> Doc
codeCell Doc
c = Doc
codeB Doc -> Doc -> Doc
<> Doc
c Doc -> Doc -> Doc
<> Doc
codeE

-- | Generate the metadata necessary for a notebook document.
makeMetadata :: Doc  
makeMetadata :: Doc
makeMetadata = [Doc] -> Doc
vcat [
  [Char] -> Doc
text [Char]
" \"metadata\": {",
  [Doc] -> Doc
vcat [
    [Char] -> Doc
text [Char]
"  \"kernelspec\": {",
    [Char] -> Doc
text [Char]
"   \"display_name\": \"Python 3\",",
    [Char] -> Doc
text [Char]
"   \"language\": \"python\",",
    [Char] -> Doc
text [Char]
"   \"name\": \"python3\"",
    [Char] -> Doc
text [Char]
"  },"],
  [Doc] -> Doc
vcat [
    [Char] -> Doc
text [Char]
"  \"language_info\": {",
    [Char] -> Doc
text [Char]
"   \"codemirror_mode\": {",
    [Char] -> Doc
text [Char]
"    \"name\": \"ipython\",",
    [Char] -> Doc
text [Char]
"    \"version\": 3",
    [Char] -> Doc
text [Char]
"   },"],
  [Char] -> Doc
text [Char]
"   \"file_extension\": \".py\",",
  [Char] -> Doc
text [Char]
"   \"mimetype\": \"text/x-python\",",
  [Char] -> Doc
text [Char]
"   \"name\": \"python\",",
  [Char] -> Doc
text [Char]
"   \"nbconvert_exporter\": \"python\",",
  [Char] -> Doc
text [Char]
"   \"pygments_lexer\": \"ipython3\",",
  [Char] -> Doc
text [Char]
"   \"version\": \"3.9.1\"",
  [Char] -> Doc
text [Char]
"  }",
  [Char] -> Doc
text [Char]
" },",
  [Char] -> Doc
text [Char]
" \"nbformat\": 4,", 
  [Char] -> Doc
text [Char]
" \"nbformat_minor\": 4" 
 ]