{-# LANGUAGE OverloadedStrings #-}
module Language.Drasil.JSON.Helpers (
Variation(..),
markdownCell, codeCell, makeMetadata,
tr, td, figure, li, pa, ba, ol, ul, table,
wrap, wrap', refwrap, refID, reflink, reflinkURI, image, h, br, mkDiv,
stripnewLine,
) where
import Prelude hiding ((<>))
import qualified Prelude
import Text.PrettyPrint (Doc, text, empty, (<>), vcat, hcat, render)
import Data.Text (Text)
import qualified Data.Text as T (lines, pack)
import Data.List (intersperse)
import Data.List.Split (splitOn)
import Drasil.Data.Formats.JSON (JSON(..))
import Language.Drasil.Document (MaxWidthPercent)
import Language.Drasil.HTML.Helpers (img)
import Language.Drasil.Printing.Helpers (bslash)
data Variation = Class | Id
tr, td, figure, li, pa, ba :: Doc -> Doc
tr :: Doc -> Doc
tr = [Char] -> [[Char]] -> Doc -> Doc
wrap [Char]
"tr" []
td :: Doc -> Doc
td = [Char] -> [[Char]] -> Doc -> Doc
wrap [Char]
"td" []
figure :: Doc -> Doc
figure = [Char] -> [[Char]] -> Doc -> Doc
wrap [Char]
"figure" []
li :: Doc -> Doc
li = [Char] -> [[Char]] -> Doc -> Doc
wrap' [Char]
"li" []
pa :: Doc -> Doc
pa = [Char] -> [[Char]] -> Doc -> Doc
wrap [Char]
"p" []
ba :: Doc -> Doc
ba = [Char] -> [[Char]] -> Doc -> Doc
wrap [Char]
"b" []
ol, ul, table :: [String] -> Doc -> Doc
ol :: [[Char]] -> Doc -> Doc
ol = [Char] -> [[Char]] -> Doc -> Doc
wrap [Char]
"ol"
ul :: [[Char]] -> Doc -> Doc
ul = [Char] -> [[Char]] -> Doc -> Doc
wrap [Char]
"ul"
table :: [[Char]] -> Doc -> Doc
table = [Char] -> [[Char]] -> Doc -> Doc
wrap [Char]
"table"
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 [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]
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 [[Char] -> Doc
tb [Char]
s, Doc
x, [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 [[Char] -> Doc
tb [Char]
s, Doc
x, [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 = [Char] -> Doc
text [Char]
"<a id=\"" Doc -> Doc -> Doc
<> Doc
i Doc -> Doc -> Doc
<> [Char] -> Doc
text [Char]
"\"></a>"
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]
")")
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>"
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 [
[([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 [
[([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
6 = [Char] -> Doc
forall a. HasCallStack => [Char] -> a
error [Char]
"Illegal header (too large)"
| Bool
otherwise = [Char] -> Doc
text (Int -> Char -> [Char]
forall a. Int -> a -> [a]
replicate Int
n Char
'#' [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" ")
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
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
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))
markdownCell :: Doc -> JSON
markdownCell :: Doc -> JSON
markdownCell Doc
d =
[(Text, JSON)] -> JSON
JObject
[ (Text
"cell_type", JSON
"markdown"),
(Text
"metadata", [(Text, JSON)] -> JSON
JObject []),
(Text
"source", Doc -> JSON
formatSource Doc
d)
]
codeCell :: Doc -> JSON
codeCell :: Doc -> JSON
codeCell Doc
d =
[(Text, JSON)] -> JSON
JObject
[ (Text
"cell_type", JSON
"code"),
(Text
"execution_count", JSON
JNull),
(Text
"metadata", [(Text, JSON)] -> JSON
JObject []),
(Text
"outputs", [JSON] -> JSON
JArray []),
(Text
"source", Doc -> JSON
formatSource Doc
d)
]
formatSource :: Doc -> JSON
formatSource :: Doc -> JSON
formatSource Doc
d =
let
d' :: [Char]
d' = Doc -> [Char]
render Doc
d
t :: Text
t = [Char] -> Text
T.pack [Char]
d'
t' :: [Text]
t' = Text -> [Text]
T.lines Text
t
in [JSON] -> JSON
JArray ([JSON] -> JSON) -> [JSON] -> JSON
forall a b. (a -> b) -> a -> b
$ (Text -> JSON) -> [Text] -> [JSON]
forall a b. (a -> b) -> [a] -> [b]
map (Text -> JSON
JString (Text -> JSON) -> (Text -> Text) -> Text -> JSON
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
Prelude.<> Text
"\n")) [Text]
t'
makeMetadata :: [(Text, JSON)]
makeMetadata :: [(Text, JSON)]
makeMetadata =
[ (Text
"metadata",
[(Text, JSON)] -> JSON
JObject
[ (Text
"kernelspec",
[(Text, JSON)] -> JSON
JObject
[ (Text
"display_name", JSON
"Python 3"),
(Text
"language", JSON
"python"),
(Text
"name", JSON
"python3")
]
),
(Text
"language_info",
[(Text, JSON)] -> JSON
JObject
[ (Text
"codemirror_mode",
[(Text, JSON)] -> JSON
JObject [(Text
"name", JSON
"ipython"), (Text
"version", Scientific -> JSON
JNumber Scientific
3)]),
(Text
"file_extension", JSON
".py"),
(Text
"mimetype", JSON
"text/x-python"),
(Text
"name", JSON
"python"),
(Text
"nbconvert_exporter", JSON
"python"),
(Text
"pygments_lexer", JSON
"ipython3"),
(Text
"version", JSON
"3.9.1")
]
)
]
),
(Text
"nbformat", Scientific -> JSON
JNumber Scientific
4),
(Text
"nbformat_minor", Scientific -> JSON
JNumber Scientific
4)
]