Commit 173a4d33 authored by Przemyslaw Kaminski's avatar Przemyslaw Kaminski

[CodeEditor] file removal, haskell fixed

parent 151471a3
...@@ -45,7 +45,7 @@ instance showViewType :: Show ViewType where ...@@ -45,7 +45,7 @@ instance showViewType :: Show ViewType where
type Props = type Props =
( code :: Code ( code :: Code
, defaultCodeType :: CodeType , defaultCodeType :: CodeType
, onChange :: Code -> Effect Unit , onChange :: CodeType -> Code -> Effect Unit
) )
-- Fixes newlines in code -- Fixes newlines in code
...@@ -112,7 +112,7 @@ codeEditorCpt = R.hooksComponent "G.C.CE.CodeEditor" cpt ...@@ -112,7 +112,7 @@ codeEditorCpt = R.hooksComponent "G.C.CE.CodeEditor" cpt
pure $ pure unit pure $ pure unit
pure $ H.div { className: "code-editor" } [ pure $ H.div { className: "code-editor" } [
toolbar controls toolbar {controls, onChange}
, H.div { className: "row error" } [ , H.div { className: "row error" } [
errorComponent {error: controls.error} errorComponent {error: controls.error}
] ]
...@@ -157,13 +157,13 @@ codeEditorCpt = R.hooksComponent "G.C.CE.CodeEditor" cpt ...@@ -157,13 +157,13 @@ codeEditorCpt = R.hooksComponent "G.C.CE.CodeEditor" cpt
previewHidden Both = "" previewHidden Both = ""
previewHidden _ = " hidden" previewHidden _ = " hidden"
onEditChange :: forall e. Record Controls -> (Code -> Effect Unit) -> e -> Effect Unit onEditChange :: forall e. Record Controls -> (CodeType -> Code -> Effect Unit) -> e -> Effect Unit
onEditChange controls@{codeElRef, codeOverlayElRef, editorCodeRef} onChange e = do onEditChange controls@{codeElRef, codeOverlayElRef, codeType: (codeType /\ _), editorCodeRef} onChange e = do
let code = R2.unsafeEventValue e let code = R2.unsafeEventValue e
R.setRef editorCodeRef code R.setRef editorCodeRef code
setCodeOverlay controls code setCodeOverlay controls code
renderHtml (R.readRef controls.editorCodeRef) controls renderHtml (R.readRef controls.editorCodeRef) controls
onChange code onChange codeType code
setCodeOverlay :: Record Controls -> Code -> Effect Unit setCodeOverlay :: Record Controls -> Code -> Effect Unit
setCodeOverlay {codeOverlayElRef, codeType: (codeType /\ _)} code = do setCodeOverlay {codeOverlayElRef, codeType: (codeType /\ _)} code = do
...@@ -190,27 +190,35 @@ renderHtml code {codeType: (codeType /\ _), htmlElRef, error: (_ /\ setError)} = ...@@ -190,27 +190,35 @@ renderHtml code {codeType: (codeType /\ _), htmlElRef, error: (_ /\ setError)} =
previewPostProcess codeType htmlEl previewPostProcess codeType htmlEl
pure unit pure unit
toolbar :: Record Controls -> R.Element type ToolbarProps = (
controls :: Record Controls
, onChange :: CodeType -> Code -> Effect Unit
)
toolbar :: Record ToolbarProps -> R.Element
toolbar p = R.createElement toolbarCpt p [] toolbar p = R.createElement toolbarCpt p []
toolbarCpt :: R.Component Controls toolbarCpt :: R.Component ToolbarProps
toolbarCpt = R.hooksComponent "G.C.CE.toolbar" cpt toolbarCpt = R.hooksComponent "G.C.CE.toolbar" cpt
where where
cpt controls@{codeType, error, viewType} _ = do cpt props@{controls: {codeType, error, viewType}} _ = do
pure $ pure $
H.div { className: "row toolbar" } [ H.div { className: "row toolbar" } [
codeTypeSelector { codeTypeSelector {
codeType codeType
, onChange: onChangeCodeType controls , onChange: onChangeCodeType props
} }
, viewTypeSelector {state: viewType} , viewTypeSelector {state: viewType}
] ]
-- Handle rerendering of preview when viewType changed -- Handle rerendering of preview when viewType changed
onChangeCodeType :: forall e. Record Controls -> e -> Effect Unit onChangeCodeType :: forall e. Record ToolbarProps -> e -> Effect Unit
onChangeCodeType controls _ = do onChangeCodeType {controls, onChange} _ = do
setCodeOverlay controls (R.readRef controls.editorCodeRef) setCodeOverlay controls code
renderHtml (R.readRef controls.editorCodeRef) controls renderHtml code controls
onChange (fst controls.codeType) code
where
code = R.readRef controls.editorCodeRef
type ErrorComponentProps = type ErrorComponentProps =
......
...@@ -118,6 +118,7 @@ fieldsCodeEditorCpt = R.hooksComponent "G.C.N.C.fieldsCodeEditorCpt" cpt ...@@ -118,6 +118,7 @@ fieldsCodeEditorCpt = R.hooksComponent "G.C.N.C.fieldsCodeEditorCpt" cpt
(\(Tuple idx field) -> (\(Tuple idx field) ->
fieldCodeEditorWrapper { field fieldCodeEditorWrapper { field
, onChange: onChange fS idx , onChange: onChange fS idx
, onRemove: onRemove fS idx
}) <$> fields }) <$> fields
onChange :: R.State (Array FTFieldWithIndex) -> Index -> FieldType -> Effect Unit onChange :: R.State (Array FTFieldWithIndex) -> Index -> FieldType -> Effect Unit
...@@ -127,10 +128,18 @@ fieldsCodeEditorCpt = R.hooksComponent "G.C.N.C.fieldsCodeEditorCpt" cpt ...@@ -127,10 +128,18 @@ fieldsCodeEditorCpt = R.hooksComponent "G.C.N.C.fieldsCodeEditorCpt" cpt
Nothing -> fields Nothing -> fields
Just newFields -> newFields Just newFields -> newFields
onRemove :: R.State (Array FTFieldWithIndex) -> Index -> Unit -> Effect Unit
onRemove (_ /\ setFields) idx _ = do
setFields $ \fields ->
case A.deleteAt idx fields of
Nothing -> fields
Just newFields -> newFields
type FieldCodeEditorProps = type FieldCodeEditorProps =
( (
field :: FTField field :: FTField
, onChange :: FieldType -> Effect Unit , onChange :: FieldType -> Effect Unit
, onRemove :: Unit -> Effect Unit
) )
fieldCodeEditorWrapper :: Record FieldCodeEditorProps -> R.Element fieldCodeEditorWrapper :: Record FieldCodeEditorProps -> R.Element
...@@ -139,9 +148,18 @@ fieldCodeEditorWrapper props = R.createElement fieldCodeEditorWrapperCpt props [ ...@@ -139,9 +148,18 @@ fieldCodeEditorWrapper props = R.createElement fieldCodeEditorWrapperCpt props [
fieldCodeEditorWrapperCpt :: R.Component FieldCodeEditorProps fieldCodeEditorWrapperCpt :: R.Component FieldCodeEditorProps
fieldCodeEditorWrapperCpt = R.hooksComponent "G.C.N.C.fieldCodeEditorWrapperCpt" cpt fieldCodeEditorWrapperCpt = R.hooksComponent "G.C.N.C.fieldCodeEditorWrapperCpt" cpt
where where
cpt props@{field: Field {name, typ}} _ = do cpt props@{field: Field {name, typ}, onRemove} _ = do
pure $ H.div { className: "row panel panel-default" } [ pure $ H.div { className: "row panel panel-default" } [
H.div { className: "panel-heading" } [ H.text name ] H.div { className: "panel-heading" } [
H.span {} [ H.text name ]
, H.div { className: "pull-right" } [
H.div { className: "btn btn-danger"
, on: { click: \_ -> onRemove unit }
} [
H.span { className: "glyphicon glyphicon-minus" } [ ]
]
]
]
, H.div { className: "panel-body" } [ , H.div { className: "panel-body" } [
fieldCodeEditor props fieldCodeEditor props
] ]
...@@ -153,30 +171,39 @@ fieldCodeEditor props = R.createElement fieldCodeEditorCpt props [] ...@@ -153,30 +171,39 @@ fieldCodeEditor props = R.createElement fieldCodeEditorCpt props []
fieldCodeEditorCpt :: R.Component FieldCodeEditorProps fieldCodeEditorCpt :: R.Component FieldCodeEditorProps
fieldCodeEditorCpt = R.hooksComponent "G.C.N.C.fieldCodeEditorCpt" cpt fieldCodeEditorCpt = R.hooksComponent "G.C.N.C.fieldCodeEditorCpt" cpt
where where
cpt {field: Field {typ: Haskell hs@{code}}, onChange} _ = do cpt {field: Field {typ: typ@(Haskell {haskell})}, onChange} _ = do
pure $ CE.codeEditor {code, defaultCodeType: CE.Haskell, onChange: onChange'} pure $ CE.codeEditor {code: haskell, defaultCodeType: CE.Haskell, onChange: changeCode onChange typ}
where cpt {field: Field {typ: typ@(JSON j)}, onChange} _ = do
onChange' :: CE.Code -> Effect Unit pure $ CE.codeEditor {code, defaultCodeType: CE.JSON, onChange: changeCode onChange typ}
onChange' c = do
onChange $ Haskell $ hs { code = c }
cpt {field: Field {typ: JSON j}, onChange} _ = do
pure $ CE.codeEditor {code, defaultCodeType: CE.JSON, onChange: onChange'}
where where
code = R2.stringify (encodeJson j) 2 code = R2.stringify (encodeJson j) 2
cpt {field: Field {typ: typ@(Markdown {text})}, onChange} _ = do
onChange' :: CE.Code -> Effect Unit pure $ CE.codeEditor {code: text, defaultCodeType: CE.Markdown, onChange: changeCode onChange typ}
onChange' c = do
-- Perofrms the matrix of code type changes
-- (FieldType -> Effect Unit) is the callback function for fields array
-- FieldType is the current element that we will modify
-- CE.CodeType is the editor code type (might have been the cause of the trigger)
-- CE.Code is the editor code (might have been the cause of the trigger)
changeCode :: (FieldType -> Effect Unit) -> FieldType -> CE.CodeType -> CE.Code -> Effect Unit
changeCode onc (Haskell hs) CE.Haskell c = onc $ Haskell $ hs { haskell = c }
changeCode onc (Haskell {haskell}) CE.JSON c = onc $ JSON $ defaultJSON' { desc = haskell }
changeCode onc (Haskell {haskell}) CE.Markdown c = onc $ Markdown $ defaultMarkdown' { text = haskell }
changeCode onc (JSON j@{desc}) CE.Haskell c = onc $ Haskell $ defaultHaskell' { haskell = haskell }
where
haskell = R2.stringify (encodeJson j) 2
changeCode onc (JSON j) CE.JSON c = do
case jsonParser c of case jsonParser c of
Left err -> log2 "[fieldCodeEditor'] cannot parse json" c Left err -> log2 "[fieldCodeEditor'] cannot parse json" c
Right j' -> case decodeJson j' of Right j' -> case decodeJson j' of
Left err -> log2 "[fieldCodeEditor'] cannot decode json" j' Left err -> log2 "[fieldCodeEditor'] cannot decode json" j'
Right j'' -> onChange $ JSON j'' Right j'' -> onc $ JSON j''
cpt {field: Field {typ: Markdown md@{text}}, onChange} _ = do changeCode onc (JSON j) CE.Markdown c = onc $ Markdown $ defaultMarkdown' { text = text }
pure $ CE.codeEditor {code: text, defaultCodeType: CE.Markdown, onChange: onChange'}
where where
onChange' :: CE.Code -> Effect Unit text = R2.stringify (encodeJson j) 2
onChange' c = do changeCode onc (Markdown md) CE.Haskell c = onc $ Haskell $ defaultHaskell' { haskell = c }
onChange $ Markdown $ md { text = c } changeCode onc (Markdown md) CE.JSON c = onc $ Markdown $ defaultMarkdown' { text = c }
changeCode onc (Markdown md) CE.Markdown c = onc $ Markdown $ md { text = c }
type LoadProps = ( type LoadProps = (
nodeId :: Int nodeId :: Int
......
...@@ -44,7 +44,7 @@ instance eqFTField :: Eq (Field FieldType) where ...@@ -44,7 +44,7 @@ instance eqFTField :: Eq (Field FieldType) where
data FieldType = data FieldType =
Haskell { Haskell {
code :: HaskellCode haskell :: HaskellCode
, tag :: Tag , tag :: Tag
} }
| JSON { | JSON {
...@@ -69,9 +69,9 @@ instance decodeFTField :: DecodeJson (Field FieldType) where ...@@ -69,9 +69,9 @@ instance decodeFTField :: DecodeJson (Field FieldType) where
data_ <- obj .: "data" data_ <- obj .: "data"
typ <- case type_ of typ <- case type_ of
"Haskell" -> do "Haskell" -> do
code <- data_ .: "code" haskell <- data_ .: "haskell"
tag <- data_ .: "tag" tag <- data_ .: "tag"
pure $ Haskell {code, tag} pure $ Haskell {haskell, tag}
"JSON" -> do "JSON" -> do
authors <- data_ .: "authors" authors <- data_ .: "authors"
desc <- data_ .: "desc" desc <- data_ .: "desc"
...@@ -96,8 +96,8 @@ instance encodeFTField :: EncodeJson (Field FieldType) where ...@@ -96,8 +96,8 @@ instance encodeFTField :: EncodeJson (Field FieldType) where
typ' (JSON _) = "JSON" typ' (JSON _) = "JSON"
typ' (Markdown _) = "Markdown" typ' (Markdown _) = "Markdown"
instance encodeFieldType :: EncodeJson FieldType where instance encodeFieldType :: EncodeJson FieldType where
encodeJson (Haskell {code}) = encodeJson (Haskell {haskell}) =
"code" := code "haskell" := haskell
~> "tag" := "HaskellField" ~> "tag" := "HaskellField"
~> jsonEmptyObject ~> jsonEmptyObject
encodeJson (JSON {authors, desc, query, tag, title}) = encodeJson (JSON {authors, desc, query, tag, title}) =
...@@ -112,13 +112,34 @@ instance encodeFieldType :: EncodeJson FieldType where ...@@ -112,13 +112,34 @@ instance encodeFieldType :: EncodeJson FieldType where
~> "text" := text ~> "text" := text
~> jsonEmptyObject ~> jsonEmptyObject
defaultField :: FTField defaultHaskell :: FieldType
defaultField = Field { defaultHaskell = Haskell defaultHaskell'
name: "New file" defaultHaskell' = {
, typ: Markdown { haskell: ""
, tag: "HaskellField"
}
defaultJSON :: FieldType
defaultJSON = JSON defaultJSON'
defaultJSON' = {
authors: ""
, desc: ""
, query: ""
, tag: "JSONField"
, title: ""
}
defaultMarkdown :: FieldType
defaultMarkdown = Markdown defaultMarkdown'
defaultMarkdown' = {
tag: "MarkdownField" tag: "MarkdownField"
, text: "# New file" , text: "# New file"
} }
defaultField :: FTField
defaultField = Field {
name: "New file"
, typ: defaultMarkdown
} }
newtype CorpusInfo = newtype CorpusInfo =
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment