chore(cms): finalising ghost exporter (#268)

Author: Varun-Sethu

utilities/ghost-exporter/Converters.fs

@@ -16,28 +16,30 @@ let convertMarkups (markups: Markups.markup list) : textStyle =
         underline = false
     }
 
+
 let convertToText (text: string) (styles: bool list) : text = 
     {
         data = Text text
         style = {
-            bold = false
-            italic = false
-            underline = false
-        } // When we inevitably switch to lists of styles we can add an additional parameter to this function to pass in the styles
+            bold = styles.Item 0
+            italic = styles.Item 1
+            underline = styles.Item 2
+        }
     }
 
+
 // This needs to be implemented properly once frontend is ready
 let convertCallout (callout: Cards.callout) : text list = 
-    [convertToText callout.text [false; false; false]]
+    [convertToText callout.calloutText [false; false; false]]
+
 
 // This needs to be implemented properly once frontend is ready
 let convertToggle (toggle: Cards.toggle) : text list = 
-    [convertToText toggle.heading [true; false; false]; convertToText toggle.body [false; false; false]]
+    [convertToText toggle.heading [true; false; false]; convertToText toggle.content [false; false; false]]
 
 
 let convertCode (code: Cards.code) : text list = 
-    [convertToText code.code [false; false; false]]
-
+    [convertToText ("=== THIS IS A CODE BLOCK === \n" + code.code) [false; false; false]]
 
 
 let convertCard (cards: Cards.card list) (cardIndex: int) : text list = 
@@ -48,44 +50,40 @@ let convertCard (cards: Cards.card list) (cardIndex: int) : text list =
                             | Toggle toggle -> convertToggle toggle
                             | Code code -> convertCode code
 
-let modifyOpenMarkups (openMarkups: int list) (newMarkups: int list) (numClosedMarkups: int) : int list = 
-    let rec removeMarkups (markups: int list, numClosedMarkups: int) : int list = 
-        match numClosedMarkups with
-        | 0 -> markups
-        | _ -> removeMarkups (List.tail markups, numClosedMarkups - 1)
-    // My current assumption is that we append newMarkups to the list and remove starting from the last markup in the list
-    removeMarkups (List.append openMarkups newMarkups, numClosedMarkups)
+
+let rec removeMarkups (openMarkups: int list) (numClosedMarkups: int) : int list =
+    match numClosedMarkups with
+        | 0 -> openMarkups
+        | _ -> removeMarkups (List.tail openMarkups) (numClosedMarkups - 1)
+
 
 let retrieveMarkups (markups: Markups.markup list) (indices: int list) : Markups.markup list = 
     List.map (fun index -> List.item index markups) indices
 
-let convertValue (sectionBlock : sectionBlock) (openMarkups : Markups.markup list) : textType = 
-    let isLink markup = 
-        match markup with
-            | Markups.Link _ -> true 
-            | _ -> false
-    
-    let listContainsLink list = 
-        List.exists (isType) list
 
-    if listContainsLink openMarkups then
-        Text sectionBlock.value // Should be URL type in future
-    else
-        Text sectionBlock.value
+let extractValue (markups: Markups.markup list) = function
+    | StringValue x -> 
+        let combinedLinks = markups
+                                |> List.map (function | Markups.Link link -> link.url | _ -> "")
+                                |> List.fold (+) ""
+        if combinedLinks <> "" then x + " (" + combinedLinks + ")" else x
+    | AtomIndex _ -> System.Environment.NewLine
+
+let convertValue (sectionBlock : sectionBlock) (openMarkups : Markups.markup list) : textType =
+    Text <| extractValue openMarkups sectionBlock.value
+
 
 let convertSectionBlocks (markups: Markups.markup list) (sectionBlock: list<sectionBlock>) : text list = 
     let rec convertSectionBlock (sections: list<sectionBlock>) (openMarkups : int list) : text list = 
         match sections with 
             | [] -> []
             | x :: xs -> 
-                let openMarkups = modifyOpenMarkups openMarkups x.openMarkups x.numClosedMarkups
+                let openMarkups = List.append openMarkups x.openMarkups 
                 let retrievedMarkups = retrieveMarkups markups openMarkups
-
                 {
                     data = convertValue x retrievedMarkups
                     style = convertMarkups retrievedMarkups
-
-                } :: (convertSectionBlock xs openMarkups)
+                } :: (convertSectionBlock xs (removeMarkups openMarkups x.numClosedMarkups))
 
     convertSectionBlock sectionBlock []
 

utilities/ghost-exporter/Main.fs

@@ -6,19 +6,20 @@ open Newtonsoft.Json
 
 open FSharpPlus
 open Fleece.Newtonsoft
-open Fleece.Newtonsoft.Operators
 open System.IO
 open Converters
 
 [<EntryPoint>]
 let main args =
-    let ghostDocument: GhostDocument ParseResult = ofJsonText (File.ReadAllText args[0])
+    let ghostDocument = ofJsonText (File.ReadAllText args[0])
 
-    let result = 
-        match Option.ofResult ghostDocument with
-        | Some document -> toJsonText (GhostToCms document) 
-        | _ -> "failed to parse ghost document"
+    match Option.ofResult ghostDocument with
+        | Some document -> 
+            // Write the result to disk
+            let compiledResult = toJsonText (GhostToCms document)
+            let fileName = Path.GetFileNameWithoutExtension (args[0])
+            File.WriteAllText ($"{Path.GetFileNameWithoutExtension (args[0])}__exported.json", compiledResult)
 
-    printfn "%s" result
+        | _ -> printfn "%s" "failed to parse ghost document"
 
     0

utilities/ghost-exporter/Models/CMSSyntax.fs

@@ -1,7 +1,6 @@
 module CMSSyntax
 
 open Fleece
-open Fleece.Newtonsoft.Operators
 
 // possible allignment of text blocks
 type alignment = 

utilities/ghost-exporter/Models/GhostSyntax.fs

@@ -11,6 +11,9 @@ open System
 
 
 module Markups = 
+    let Success = Decode.Success
+    let Invalid = Decode.Fail.invalidValue
+
     type link = { linkType: string; url: string }
     type markup = 
         | Link of link
@@ -20,14 +23,18 @@ module Markups =
     with
         static member OfJson json = 
             match json with
-            | JArray o ->
-                match List.ofSeq o with
-                | (JString "a")         :: (JString lType) :: (JString url) :: [] -> Decode.Success (Link { linkType = lType; url = url })
-                | (JString "code")      :: [] -> Decode.Success Code
-                | (JString "em")        :: [] -> Decode.Success Emphasis
-                | (JString "strong")    :: [] -> Decode.Success Strong
-                | _ -> Decode.Fail.invalidValue json "failed to parse into markup"
-            | _ -> Decode.Fail.arrExpected json
+            | JArray arr -> 
+                match List.ofSeq arr with
+                    | [(JString "code")] -> Success Code
+                    | [(JString "em")] -> Success Emphasis
+                    | [(JString "strong")] -> Success Strong
+                    | [(JString "a"); (JArray o)] -> 
+                        match List.ofSeq o with 
+                            | [(JString lType); (JString url)] -> Success <| Link { linkType = lType; url = url }
+                            | _ -> Invalid json "failed to parse into reference markup"
+                    | _ -> Invalid json "failed to parse into markup"
+            | o -> Decode.Fail.arrExpected o
+
 
 module Cards = 
     // Callout cards can be directly translated into CMS paragraph blocks
@@ -72,50 +79,58 @@ module Cards =
             match json with
             | JArray o ->
                 match List.ofSeq o with
-                | (JString "callout") :: (cardObject: Encoding) :: [] -> Callout <!> (callout.OfJson cardObject)
-                | (JString "toggle")  :: (cardObject: Encoding) :: [] -> Toggle <!> (toggle.OfJson cardObject)
-                | (JString "code")    :: (cardObject: Encoding) :: [] -> Code <!> (code.OfJson cardObject)
+                | [JString "callout"; cardObject: Encoding] -> Callout <!> (callout.OfJson cardObject)
+                | [JString "toggle"; cardObject: Encoding] -> Toggle <!> (toggle.OfJson cardObject)
+                | [JString "code"; cardObject: Encoding] -> Code <!> (code.OfJson cardObject)
                 | _ -> Decode.Fail.invalidValue json "failed to parse into card"
             | _ -> Decode.Fail.arrExpected json
 
 
 module Sections = 
     type sectionTag =
-    | Paragraph
-    | Heading
-    | Card
+        | Paragraph
+        | Heading
+        | Card
 
     // Specialised parsers since this library doesn't seem to give us any :(((((((
     // Might stack overflow on large lists but I dont see us ever having to deal with that, if stack overflows are an issue just optimise to be tail call recursive
     let rec parseListInner (parser: Encoding -> Result<'a, DecodeError>) arr : Result<'a list, DecodeError> =
         match arr with
+        | [] -> Ok []
         | x :: xs -> match parseListInner parser xs with
                         | Ok arr -> (fun parsedValue -> parsedValue :: arr) <!> (parser x)
                         | Error x -> Error x
-        | [] -> Ok []
 
     let parseList parser arr = parseListInner parser (List.ofSeq arr)
     let parseNumberList = parseList (function | JNumber x -> Ok (Decimal.ToInt32 x) | x -> Decode.Fail.numExpected x) 
 
     // Individual styling rules for a section
+    type sectionType = 
+        | AtomIndex of int
+        | StringValue of string
+
     type sectionBlock = {
         openMarkups: int list;
         numClosedMarkups: int;
-        value: string;
+        value: sectionType;
     } with
+        static member createSectionBlock = fun openMarkups numClosedMarkups value -> { openMarkups = openMarkups; numClosedMarkups = numClosedMarkups; value = value }
         static member OfJson json =
             match json with
             | JArray o -> match List.ofSeq o with
-                            | (JNumber 0m) :: (JArray openMarkups) :: (JNumber numClosedMarkups) :: (JString text) :: [] ->
-                                (fun openMarkups numClosedMarkups text -> { openMarkups = openMarkups; numClosedMarkups = numClosedMarkups; value = text })
-                                <!> (parseNumberList openMarkups)
-                                <*> (Ok (Decimal.ToInt32 numClosedMarkups))
-                                <*> (Ok text)
+                            | [JNumber sectionType; JArray openMarkups; JNumber numClosedMarkups; value] ->
+                                let block = sectionBlock.createSectionBlock <!> (parseNumberList openMarkups) <*> (Ok (Decimal.ToInt32 numClosedMarkups))
+                                match (sectionType, value) with
+                                    | (0m, JString text) -> block <*> (Ok <| StringValue text)
+                                    | (1m, JNumber atomIndex) -> block <*> (Ok <| AtomIndex (Decimal.ToInt32 atomIndex))
+                                    | _ -> Decode.Fail.invalidValue json "failed to parse section type"
+
                             | _ -> Decode.Fail.invalidValue json "failed to parse into section block"
 
             | json -> Decode.Fail.arrExpected json
 
-    let parseSectionBlockList = parseList sectionBlock.OfJson 
+    let parseSectionBlockList = parseList sectionBlock.OfJson
+    let parseSectionBlockListInner = parseListInner sectionBlock.OfJson
 
     type blockValue =
         | Section of list<sectionBlock>
@@ -126,15 +141,35 @@ module Sections =
         tag: sectionTag;
         blocks: blockValue;
     } with
+        static member createSection = fun sections tag -> { tag = tag; blocks = Section sections }
         static member OfJson json =
             match json with
             | JArray o -> match List.ofSeq o with
-                            | (JNumber 1m) :: (JString "p") :: (JArray subsections) :: [] -> (fun sections -> { tag = Paragraph; blocks = Section sections }) <!> (parseSectionBlockList subsections)
-                            | (JNumber 1m) :: (JString "h2") :: (JArray subsections) :: [] -> (fun sections -> { tag = Heading; blocks = Section sections }) <!> (parseSectionBlockList subsections)
-                            | (JNumber 10m) :: (JNumber x) :: [] -> Decode.Success { tag = Card; blocks = CardReference <| Decimal.ToInt32 x }
-                            | _ -> Decode.Fail.invalidValue json "failed to parse into sections"
-            | json -> Decode.Fail.arrExpected json
-    // Sections are the core of the ghost mobiledoc format, they're what will directly dictate the structure of the exported CMS json
+                            | [JNumber 10m; JNumber x] -> Decode.Success { tag = Card; blocks = CardReference <| Decimal.ToInt32 x }
+                            | [JNumber 3m; JString sectionType; JArray subsectionArray] ->
+                                // this is so hacky im sorry :(, please fix this later
+                                let rec sequenceSubsections = function
+                                    | [] -> Ok []
+                                    | x :: xs -> 
+                                        match x with
+                                        | JArray inner -> match parseSectionBlockList inner with
+                                                            | Ok arr -> (fun parsedValue -> List.append arr parsedValue) <!> (sequenceSubsections xs)
+                                                            | Error x -> Error x
+                                        | o -> Decode.Fail.arrExpected o
+
+                                section.createSection <!> (sequenceSubsections <| List.ofSeq subsectionArray) <*> (Ok Paragraph)
+
+                            | [JNumber 1m; JString sectionType; JArray subsections] ->
+                                let partialSection = section.createSection <!> (parseSectionBlockList subsections)
+                                match sectionType with
+                                    | "p" -> partialSection <*> (Ok Paragraph)
+                                    | "h2" | "h3" | "h4" -> partialSection <*> (Ok Heading)
+                                    | _ -> Decode.Fail.invalidValue json "failed to parse into sections"
+
+                            |  _ -> Decode.Fail.invalidValue json "failed to parse into sections"
+            | json -> 
+                printf "%A" json
+                Decode.Fail.arrExpected json
 
 
 type GhostDocument = {
@@ -149,7 +184,6 @@ type GhostDocument = {
                 let! markups = o .@ "markups"
                 let! cards = o .@ "cards"
                 let! sections = o .@ "sections"
-
                 return {
                     Cards = cards
                     Markups = markups