Make `toJSON` a computed property, and fileprivate

Original commit 596d39ac55a62b591676934519641a5ed7073944

module Language.Swift
    ( renderer
    ) where

import Doc
import IRGraph
import Prelude

import Data.Array as A
import Data.Char.Unicode (isAlphaNum, isDigit)
import Data.Foldable (for_)
import Data.FoldableWithIndex (forWithIndex_)
import Data.Map (Map)
import Data.Map as M
import Data.Maybe (Maybe(..))
import Data.Set (Set)
import Data.Set as S
import Data.String.Util (camelCase, capitalize, decapitalize, genericStringEscape, intToHex, legalizeCharacters, startWithLetter)
import Data.Tuple (Tuple(..))
import Utils (removeElement)

keywords :: Array String
keywords =
    [ "associatedtype", "class", "deinit", "enum", "extension", "fileprivate", "func", "import", "init", "inout", "internal", "let", "open", "operator", "private", "protocol", "public", "static", "struct", "subscript", "typealias", "var"
    , "break", "case", "continue", "default", "defer", "do", "else", "fallthrough", "for", "guard", "if", "in", "repeat", "return", "switch", "where", "while"
    , "as", "Any", "catch", "false", "is", "nil", "rethrows", "super", "self", "Self", "throw", "throws", "true", "try"
    , "_"
    , "associativity", "convenience", "dynamic", "didSet", "final", "get", "infix", "indirect", "lazy", "left", "mutating", "nonmutating", "optional", "override", "postfix", "precedence", "prefix", "Protocol", "required", "right", "set", "Type", "unowned", "weak", "willSet"
    , "String", "Int", "Double", "Bool", "Data", "CommandLine", "FileHandle", "JSONSerialization"
    , "checkNull", "removeNSNull", "nilToNSNull", "convertArray", "convertOptional", "convertDict", "convertDouble"
    ]

renderer :: Renderer
renderer =
    { name: "Swift"
    , aceMode: "swift"
    , extension: "swift"
    , doc: swiftDoc
    , transforms:
        { nameForClass: simpleNamer nameForClass
        , nextName: \s -> "Other" <> s
        , forbiddenNames: keywords
        , topLevelName: forbidNamer (swiftNameStyle true) (\n -> [swiftNameStyle true n])
        , unions: Just
            { predicate: unionIsNotSimpleNullable
            , properName: simpleNamer (swiftNameStyle true <<< combineNames)
            , nameFromTypes: simpleNamer (unionNameIntercalated (swiftNameStyle true) "Or")
            }
        }
    }

swiftNameStyle :: Boolean -> String -> String
swiftNameStyle isUpper =
    legalizeCharacters isPartCharacter >>> camelCase >>> startWithLetter isStartCharacter isUpper
    where
        isStartCharacter :: Char -> Boolean
        isStartCharacter c = c == '_' || (isAlphaNum c && not (isDigit c))

        isPartCharacter :: Char -> Boolean
        isPartCharacter c = c == '_' || isAlphaNum c

nameForClass :: IRClassData -> String
nameForClass (IRClassData { names }) = swiftNameStyle true $ combineNames names

stringEscape :: String -> String
stringEscape =
    genericStringEscape unicodeEscape
    where
        unicodeEscape i =
            ['\\', 'u', '{'] <> intToHex 0 i <> ['}']

swiftDoc :: Doc Unit
swiftDoc = do
    line "// To parse the JSON, add this file to your project and do:"
    line "//"
    forEachTopLevel_ \topLevelName topLevelType -> do
        typ <- renderType topLevelType
        line $ "//   let " <> decapitalize topLevelName <> " = " <> topLevelName <> "(fromString: jsonString)!"
    blank
    line "import Foundation"

    forEachTopLevel_ \topLevelName topLevelType -> do
        blank
        top <- renderType topLevelType
        line $ "typealias "<> topLevelName <> " = " <> top

    forEachClass_ \className properties -> do
        blank
        renderClassDefinition className properties

    forEachUnion_ \unionName unionTypes -> do
        blank
        renderUnionDefinition unionName unionTypes

    blank
    line $ "// Serialization extensions"

    forEachTopLevel_ renderTopLevelExtensions

    forEachClass_ \className properties -> do
        blank
        renderClassExtension className properties

    forEachUnion_ \unionName unionTypes -> do
        blank
        renderUnionExtension unionName unionTypes

    blank
    supportFunctions

supportFunctions :: Doc Unit
supportFunctions = do
    line """// Helpers

fileprivate func convertArray<T>(converter: (Any) -> T?, json: Any) -> [T]? {
    guard let jsonArr = json as? [Any] else { return nil }
    var arr: [T] = []
    for v in jsonArr {
        if let converted = converter(v) {
            arr.append(converted)
        } else {
            return nil
        }
    }
    return arr
}

fileprivate func convertOptional<T>(converter: (Any) -> T?, json: Any?) -> T?? {
    guard let v = json
    else {
        return Optional.some(nil)
    }
    return converter(v)
}

fileprivate func convertDict<T>(converter: (Any) -> T?, json: Any?) -> [String: T]? {
    guard let jsonDict = json as? [String: Any] else { return nil }
    var dict: [String: T] = [:]
    for (k, v) in jsonDict {
        if let converted = converter(v) {
            dict[k] = converted
        } else {
            return nil
        }
    }
    return dict
}

fileprivate func convertToAny<T>(dictionary: [String: T], converter: (T) -> Any) -> Any {
    var result: [String: Any] = [:]
    for (k, v) in dictionary {
        result[k] = converter(v)
    }
    return result
}

fileprivate func convertDouble(_ v: Any) -> Double? {
    if let w = v as? Double {
        return w
    }
    if let w = v as? Int {
        return Double(w)
    }
    return nil
}

fileprivate let falseType = NSNumber(value: false).objCType
fileprivate let trueNumber = NSNumber(value: true)
fileprivate let trueType = trueNumber.objCType

fileprivate func convertBool(_ v: Any?) -> Bool? {
    guard let number = v as? NSNumber
    else {
        if let b = v as? Bool {
            return b
        }
        return nil
    }

    if number.objCType != falseType && number.objCType != trueType {
        return nil
    }
    return number.isEqual(trueNumber)
}

fileprivate func removeNSNull(_ v: Any?) -> Any? {
    if let w = v {
        if w is NSNull {
            return nil
        }
        return w
    }
    return nil
}

fileprivate func checkNull(_ v: Any?) -> Any?? {
    if v != nil {
        return Optional.none
    }
    return Optional.some(nil)
}"""

renderUnion :: IRUnionRep -> Doc String
renderUnion ur =
    case nullableFromSet $ unionToSet ur of
    Just r -> do
        rendered <- renderType r
        pure $ rendered <> "?"
    Nothing -> lookupUnionName ur

renderType :: IRType -> Doc String
renderType = case _ of
    IRNothing -> pure "Any?"
    IRNull -> pure "Any?"
    IRInteger -> pure "Int"
    IRDouble -> pure "Double"
    IRBool -> pure "Bool"
    IRString -> pure "String"
    IRArray a -> do
        rendered <- renderType a
        pure $ "[" <> rendered <> "]"
    IRClass i -> lookupClassName i
    IRMap t -> do
        rendered <- renderType t
        pure $ "[String: " <> rendered <> "]"
    IRUnion ur -> renderUnion ur

convertAny :: IRType -> String -> Doc String
convertAny (IRArray a) var = do
    converter <- convertAnyFunc a
    pure $ "convertArray(converter: " <> converter <> ", json: " <> var <> ")"
convertAny (IRMap m) var = do
    converter <- convertAnyFunc m
    pure $ "convertDict(converter: " <> converter <> ", json: " <> var <> ")"
convertAny (IRUnion ur) var =
    case nullableFromSet $ unionToSet ur of
    Just t -> do
        converter <- convertAnyFunc t
        pure $ "convertOptional(converter: " <> converter <> ", json: " <> var <> ")"
    Nothing -> do
        name <- lookupUnionName ur
        pure $ name <> ".fromJson(" <> var <> ")"
convertAny IRNothing var =
    pure var
convertAny IRBool var =
    pure $ "convertBool(" <> var <> ")"
convertAny IRInteger var =
    pure $ var <> " as? Int"
convertAny IRString var =
    pure $ var <> " as? String"
convertAny t var = do
    converter <- convertAnyFunc t
    pure $ converter <> "(" <> var <> ")"

convertAnyFunc :: IRType -> Doc String
convertAnyFunc = case _ of
    IRClass i -> do
        name <- lookupClassName i
        -- TODO make this look less alien
        pure $ "({ (a: Any) in " <> name <> "(fromAny: a)})"
    IRUnion ur ->
        case nullableFromSet $ unionToSet ur of
        Just t -> do
            converter <- convertAnyFunc t
            pure $ "{ (json: Any) in convertOptional(converter: " <> converter <> ", json: json) }"
        Nothing -> do
            name <- lookupUnionName ur
            pure $ name <> ".fromJson"
    IRDouble -> pure "convertDouble"
    IRNull -> pure "checkNull"
    t -> do
        converted <- convertAny t "json"
        pure $ "{ (json: Any) in " <> converted <> " }"

convertToAny :: IRType -> String -> Doc String
convertToAny (IRArray a) var = do
    rendered <- renderType a
    convertCode <- convertToAny a "v"
    pure $ var <> ".map({ (v: " <> rendered <> ") in " <> convertCode <> " }) as Any"
convertToAny (IRMap m) var = do
    rendered <- renderType m
    convertCode <- convertToAny m "v"
    pure $ "convertToAny(dictionary: " <> var <> ", converter: { (v: " <> rendered <> ") in " <> convertCode <> " })"
convertToAny (IRClass i) var =
    pure $ var <> ".asAny"
convertToAny (IRUnion ur) var =
    case nullableFromSet $ unionToSet ur of
    Just t -> do
        rendered <- renderType t
        convertCode <- convertToAny t "v"
        pure $ var <> ".map({ (v: " <> rendered <> ") in " <> convertCode  <> " }) ?? NSNull()"
    Nothing ->
        pure $ var <> ".asAny"
convertToAny IRNothing var =
    pure $ var <> " ?? NSNull()"
convertToAny IRNull var =
    pure $ "NSNull() as Any"
convertToAny _ var =
    pure $ var <> " as Any"

renderClassDefinition :: String -> Map String IRType -> Doc Unit
renderClassDefinition className properties = do
    let forbidden = keywords <> ["jsonUntyped", "json"]
    let propertyNames = makePropertyNames properties "" forbidden
    line $ "struct " <> className <> " {"
    indent do
        forEachProperty_ properties propertyNames \_ ptype fieldName _ -> do
            rendered <- renderType ptype
            line $ "let " <> fieldName <> ": " <> rendered
    line "}"

renderTopLevelExtensions :: String -> IRType -> Doc Unit
renderTopLevelExtensions topLevelName topLevelType = do
    blank

    topLevelRendered <- renderType topLevelType
    extensionType <- case topLevelType of
        IRArray t -> ("Array where Element == " <> _) <$> renderType t
        IRMap t -> ("Dictionary where Key == String, Value == " <> _) <$> renderType t
        _ -> pure topLevelRendered

    line $ "extension " <> extensionType <> " {"
    indent do
        line $ "init?(fromString json: String, using encoding: String.Encoding = .utf8) {"
        indent do
            line "guard let data = json.data(using: encoding) else { return nil }"
            line "self.init(fromData: data)"
        line "}"
        blank
        line $ "init?(fromData data: Data) {"
        indent do
            line "guard let json = try? JSONSerialization.jsonObject(with: data, options: []) else { return nil }"
            line "self.init(fromAny: json)"
        line "}"

        case topLevelType of
            IRArray _ ->  do
                blank
                line $ "init?(fromAny untyped: Any) {"
                indent do
                    convertCode <- convertAny topLevelType "untyped"
                    line $ "guard let elements = " <> convertCode <> " else { return nil }"
                    line $ "self.init(elements)"
                line "}"
            IRMap _ -> do
                blank
                line $ "init?(fromAny untyped: Any) {"
                indent do
                    convertCode <- convertAny topLevelType "untyped"
                    line $ "guard let elements = " <> convertCode <> " else { return nil }"
                    line $ "self.init()"
                    line $ "elements.forEach { self[$0.key] = $0.value }"
                line "}"
            _ -> pure unit

        blank
        line $ "var jsonData: Data? {"
        indent do
            convertCode <- convertToAny topLevelType "self"
            line $ "let json = " <> convertCode
            line "return try? JSONSerialization.data(withJSONObject: json, options: [])"
        line "}"

        blank
        line $ "var jsonString: String? {"
        indent do
            line $ "guard let data = self.jsonData else { return nil }"
            line $ "return String(data: data, encoding: .utf8)"
        line "}"

    line "}"

renderClassExtension :: String -> Map String IRType -> Doc Unit
renderClassExtension className properties = do
    let forbidden = keywords <> ["jsonUntyped", "json"]
    let propertyNames = makePropertyNames properties "" forbidden
    line $ "extension " <> className <> " {"
    indent do
        line $ "init?(fromAny jsonUntyped: Any) {"
        indent do
            line "guard let json = jsonUntyped as? [String: Any] else { return nil }"
            let forbiddenForUntyped = forbidden <> (A.fromFoldable $ M.keys propertyNames)
            let untypedNames = makePropertyNames properties "Untyped" forbiddenForUntyped
            let forbiddenForConverted = forbiddenForUntyped <> (A.fromFoldable $ M.keys untypedNames)
            let convertedNames = makePropertyNames properties "Converted" forbiddenForConverted
            forEachProperty_ properties untypedNames \pname ptype untypedName _ -> do
                when (canBeNull ptype) do
                    line $ "let " <> untypedName <> " = removeNSNull(json[\"" <> stringEscape pname <> "\"])"
            unless (M.isEmpty properties) do
                line "guard"
                indent do
                    forEachProperty_ properties untypedNames \pname ptype untypedName isLast -> do
                        let convertedName = lookupName pname convertedNames
                        unless (canBeNull ptype) do
                            line $ "let " <> untypedName <> " = removeNSNull(json[\"" <> stringEscape pname <> "\"]),"
                        convertCode <- convertAny ptype untypedName
                        line $ "let " <> convertedName <> " = " <> convertCode <> (if isLast then "" else ",")
                    line "else { return nil }"
            forEachProperty_ properties propertyNames \pname _ fieldName _ -> do
                let convertedName = lookupName pname convertedNames
                line $ "self." <> fieldName <> " = " <> convertedName
        line "}"
        blank
        line "fileprivate var asAny: Any {"
        indent do
            line "var dict = [String: Any]()"
            forEachProperty_ properties propertyNames \pname ptype fieldName _ -> do
                convertCode <- convertToAny ptype ("self." <> fieldName)
                line $ "dict[\"" <> stringEscape pname <> "\"] = " <> convertCode
            line "return dict"
        line "}"
    line "}"

forEachProperty_ :: Map String IRType -> Map String String -> (String -> IRType -> String -> Boolean -> Doc Unit) -> Doc Unit
forEachProperty_ properties propertyNames f =
    let propertyArray = M.toUnfoldable properties :: Array _
        lastIndex = A.length propertyArray - 1
    in
        forWithIndex_ propertyArray \i (Tuple pname ptype) -> do
            let fieldName = lookupName pname propertyNames
            f pname ptype fieldName (i == lastIndex)

makePropertyNames :: Map String IRType -> String -> Array String -> Map String String
makePropertyNames properties suffix forbidden =
    transformPropertyNames (fieldNamer suffix) otherField forbidden properties
    where
        fieldNamer :: String -> Namer String
        fieldNamer suffix = simpleNamer \name -> swiftNameStyle false name <> suffix

        otherField :: String -> String
        otherField name = "other" <> capitalize name

renderUnionDefinition :: String -> Set IRType -> Doc Unit
renderUnionDefinition unionName unionTypes = do
    let { element: emptyOrNull, rest: nonNullTypes } = removeElement (_ == IRNull) unionTypes
    line $ "enum " <> unionName <> " {"
    indent do
        for_ nonNullTypes \typ -> do
            name <- caseName typ
            rendered <- renderType typ
            line $ "case " <> name <> "(" <> rendered <> ")"
        case emptyOrNull of
            Just t -> do
                name <- caseName t
                line $ "case " <> name
            Nothing -> pure unit
    line "}"

renderUnionExtension :: String -> Set IRType -> Doc Unit
renderUnionExtension unionName unionTypes = do
    let { element: emptyOrNull, rest: nonNullTypes } = removeElement (_ == IRNull) unionTypes
    line $ "extension " <> unionName <> " {"
    indent do
        line $ "static func fromJson(_ v: Any) -> " <> unionName <> "? {"
        indent do
            case emptyOrNull of
                Just t -> do
                    name <- caseName t
                    line "guard let v = removeNSNull(v)"
                    line "else {"
                    indent do
                        line $ "return " <> unionName <> "." <> name
                    line "}"
                Nothing -> pure unit
            when (S.member IRBool unionTypes) do
                renderCase IRBool
            when (S.member IRInteger unionTypes) do
                renderCase IRInteger
            for_ (S.difference nonNullTypes $ S.fromFoldable [IRBool, IRInteger]) \typ -> do
                renderCase typ
            line "return nil"
        line "}"
        blank
        line $ "var asAny: Any {"
        indent do
            line $ "switch self {"
            for_ unionTypes \typ -> do
                name <- caseName typ
                let letString = if typ == IRNull then "" else "(let x)"
                line $ "case ." <> name <> letString <> ":"
                indent do
                    convertCode <- convertToAny typ "x"
                    line $ "return " <> convertCode
            line "}"
        line "}"
    line "}"
    where
    renderCase :: IRType -> Doc Unit
    renderCase t = do
        convertCode <- convertAny t "v"
        line $ "if let x = " <> convertCode <> " {"
        indent do
            name <- caseName t
            line $ "return " <> unionName <> "." <> name <> "(x)"
        line "}"

caseName :: IRType -> Doc String
caseName t = swiftNameStyle false <$> getTypeNameForUnion t

module Language.Swift
    ( renderer
    ) where

import Doc
import IRGraph
import Prelude

import Data.Array as A
import Data.Char.Unicode (isAlphaNum, isDigit)
import Data.Foldable (for_)
import Data.FoldableWithIndex (forWithIndex_)
import Data.Map (Map)
import Data.Map as M
import Data.Maybe (Maybe(..))
import Data.Set (Set)
import Data.Set as S
import Data.String.Util (camelCase, capitalize, decapitalize, genericStringEscape, intToHex, legalizeCharacters, startWithLetter)
import Data.Tuple (Tuple(..))
import Utils (removeElement)

keywords :: Array String
keywords =
    [ "associatedtype", "class", "deinit", "enum", "extension", "fileprivate", "func", "import", "init", "inout", "internal", "let", "open", "operator", "private", "protocol", "public", "static", "struct", "subscript", "typealias", "var"
    , "break", "case", "continue", "default", "defer", "do", "else", "fallthrough", "for", "guard", "if", "in", "repeat", "return", "switch", "where", "while"
    , "as", "Any", "catch", "false", "is", "nil", "rethrows", "super", "self", "Self", "throw", "throws", "true", "try"
    , "_"
    , "associativity", "convenience", "dynamic", "didSet", "final", "get", "infix", "indirect", "lazy", "left", "mutating", "nonmutating", "optional", "override", "postfix", "precedence", "prefix", "Protocol", "required", "right", "set", "Type", "unowned", "weak", "willSet"
    , "String", "Int", "Double", "Bool", "Data", "CommandLine", "FileHandle", "JSONSerialization"
    , "checkNull", "removeNSNull", "nilToNSNull", "convertArray", "convertOptional", "convertDict", "convertDouble"
    ]

renderer :: Renderer
renderer =
    { name: "Swift"
    , aceMode: "swift"
    , extension: "swift"
    , doc: swiftDoc
    , transforms:
        { nameForClass: simpleNamer nameForClass
        , nextName: \s -> "Other" <> s
        , forbiddenNames: keywords
        , topLevelName: forbidNamer (swiftNameStyle true) (\n -> [swiftNameStyle true n])
        , unions: Just
            { predicate: unionIsNotSimpleNullable
            , properName: simpleNamer (swiftNameStyle true <<< combineNames)
            , nameFromTypes: simpleNamer (unionNameIntercalated (swiftNameStyle true) "Or")
            }
        }
    }

swiftNameStyle :: Boolean -> String -> String
swiftNameStyle isUpper =
    legalizeCharacters isPartCharacter >>> camelCase >>> startWithLetter isStartCharacter isUpper
    where
        isStartCharacter :: Char -> Boolean
        isStartCharacter c = c == '_' || (isAlphaNum c && not (isDigit c))

        isPartCharacter :: Char -> Boolean
        isPartCharacter c = c == '_' || isAlphaNum c

nameForClass :: IRClassData -> String
nameForClass (IRClassData { names }) = swiftNameStyle true $ combineNames names

stringEscape :: String -> String
stringEscape =
    genericStringEscape unicodeEscape
    where
        unicodeEscape i =
            ['\\', 'u', '{'] <> intToHex 0 i <> ['}']

swiftDoc :: Doc Unit
swiftDoc = do
    line "// To parse the JSON, add this file to your project and do:"
    line "//"
    forEachTopLevel_ \topLevelName topLevelType -> do
        typ <- renderType topLevelType
        line $ "//   let " <> decapitalize topLevelName <> " = " <> topLevelName <> "(fromString: jsonString)!"
    blank
    line "import Foundation"

    forEachTopLevel_ \topLevelName topLevelType -> do
        blank
        top <- renderType topLevelType
        line $ "typealias "<> topLevelName <> " = " <> top

    forEachClass_ \className properties -> do
        blank
        renderClassDefinition className properties

    forEachUnion_ \unionName unionTypes -> do
        blank
        renderUnionDefinition unionName unionTypes

    blank
    line $ "// Serialization extensions"

    forEachTopLevel_ renderTopLevelExtensions

    forEachClass_ \className properties -> do
        blank
        renderClassExtension className properties

    forEachUnion_ \unionName unionTypes -> do
        blank
        renderUnionExtension unionName unionTypes

    blank
    supportFunctions

supportFunctions :: Doc Unit
supportFunctions = do
    line """// Helpers

fileprivate func convertArray<T>(converter: (Any) -> T?, json: Any) -> [T]? {
    guard let jsonArr = json as? [Any] else { return nil }
    var arr: [T] = []
    for v in jsonArr {
        if let converted = converter(v) {
            arr.append(converted)
        } else {
            return nil
        }
    }
    return arr
}

fileprivate func convertOptional<T>(converter: (Any) -> T?, json: Any?) -> T?? {
    guard let v = json
    else {
        return Optional.some(nil)
    }
    return converter(v)
}

fileprivate func convertDict<T>(converter: (Any) -> T?, json: Any?) -> [String: T]? {
    guard let jsonDict = json as? [String: Any] else { return nil }
    var dict: [String: T] = [:]
    for (k, v) in jsonDict {
        if let converted = converter(v) {
            dict[k] = converted
        } else {
            return nil
        }
    }
    return dict
}

fileprivate func convertToAny<T>(dictionary: [String: T], converter: (T) -> Any) -> Any {
    var result: [String: Any] = [:]
    for (k, v) in dictionary {
        result[k] = converter(v)
    }
    return result
}

fileprivate func convertDouble(_ v: Any) -> Double? {
    if let w = v as? Double {
        return w
    }
    if let w = v as? Int {
        return Double(w)
    }
    return nil
}

fileprivate let falseType = NSNumber(value: false).objCType
fileprivate let trueNumber = NSNumber(value: true)
fileprivate let trueType = trueNumber.objCType

fileprivate func convertBool(_ v: Any?) -> Bool? {
    guard let number = v as? NSNumber
    else {
        if let b = v as? Bool {
            return b
        }
        return nil
    }

    if number.objCType != falseType && number.objCType != trueType {
        return nil
    }
    return number.isEqual(trueNumber)
}

fileprivate func removeNSNull(_ v: Any?) -> Any? {
    if let w = v {
        if w is NSNull {
            return nil
        }
        return w
    }
    return nil
}

fileprivate func checkNull(_ v: Any?) -> Any?? {
    if v != nil {
        return Optional.none
    }
    return Optional.some(nil)
}"""

renderUnion :: IRUnionRep -> Doc String
renderUnion ur =
    case nullableFromSet $ unionToSet ur of
    Just r -> do
        rendered <- renderType r
        pure $ rendered <> "?"
    Nothing -> lookupUnionName ur

renderType :: IRType -> Doc String
renderType = case _ of
    IRNothing -> pure "Any?"
    IRNull -> pure "Any?"
    IRInteger -> pure "Int"
    IRDouble -> pure "Double"
    IRBool -> pure "Bool"
    IRString -> pure "String"
    IRArray a -> do
        rendered <- renderType a
        pure $ "[" <> rendered <> "]"
    IRClass i -> lookupClassName i
    IRMap t -> do
        rendered <- renderType t
        pure $ "[String: " <> rendered <> "]"
    IRUnion ur -> renderUnion ur

convertAny :: IRType -> String -> Doc String
convertAny (IRArray a) var = do
    converter <- convertAnyFunc a
    pure $ "convertArray(converter: " <> converter <> ", json: " <> var <> ")"
convertAny (IRMap m) var = do
    converter <- convertAnyFunc m
    pure $ "convertDict(converter: " <> converter <> ", json: " <> var <> ")"
convertAny (IRUnion ur) var =
    case nullableFromSet $ unionToSet ur of
    Just t -> do
        converter <- convertAnyFunc t
        pure $ "convertOptional(converter: " <> converter <> ", json: " <> var <> ")"
    Nothing -> do
        name <- lookupUnionName ur
        pure $ name <> ".fromJson(" <> var <> ")"
convertAny IRNothing var =
    pure var
convertAny IRBool var =
    pure $ "convertBool(" <> var <> ")"
convertAny IRInteger var =
    pure $ var <> " as? Int"
convertAny IRString var =
    pure $ var <> " as? String"
convertAny t var = do
    converter <- convertAnyFunc t
    pure $ converter <> "(" <> var <> ")"

convertAnyFunc :: IRType -> Doc String
convertAnyFunc = case _ of
    IRClass i -> do
        name <- lookupClassName i
        -- TODO make this look less alien
        pure $ "({ (a: Any) in " <> name <> "(fromAny: a)})"
    IRUnion ur ->
        case nullableFromSet $ unionToSet ur of
        Just t -> do
            converter <- convertAnyFunc t
            pure $ "{ (json: Any) in convertOptional(converter: " <> converter <> ", json: json) }"
        Nothing -> do
            name <- lookupUnionName ur
            pure $ name <> ".fromJson"
    IRDouble -> pure "convertDouble"
    IRNull -> pure "checkNull"
    t -> do
        converted <- convertAny t "json"
        pure $ "{ (json: Any) in " <> converted <> " }"

convertToAny :: IRType -> String -> Doc String
convertToAny (IRArray a) var = do
    rendered <- renderType a
    convertCode <- convertToAny a "v"
    pure $ var <> ".map({ (v: " <> rendered <> ") in " <> convertCode <> " }) as Any"
convertToAny (IRMap m) var = do
    rendered <- renderType m
    convertCode <- convertToAny m "v"
    pure $ "convertToAny(dictionary: " <> var <> ", converter: { (v: " <> rendered <> ") in " <> convertCode <> " })"
convertToAny (IRClass i) var =
    pure $ var <> ".toJSON()"
convertToAny (IRUnion ur) var =
    case nullableFromSet $ unionToSet ur of
    Just t -> do
        rendered <- renderType t
        convertCode <- convertToAny t "v"
        pure $ var <> ".map({ (v: " <> rendered <> ") in " <> convertCode  <> " }) ?? NSNull()"
    Nothing ->
        pure $ var <> ".toJSON()"
convertToAny IRNothing var =
    pure $ var <> " ?? NSNull()"
convertToAny IRNull var =
    pure $ "NSNull() as Any"
convertToAny _ var =
    pure $ var <> " as Any"

renderClassDefinition :: String -> Map String IRType -> Doc Unit
renderClassDefinition className properties = do
    let forbidden = keywords <> ["jsonUntyped", "json"]
    let propertyNames = makePropertyNames properties "" forbidden
    line $ "struct " <> className <> " {"
    indent do
        forEachProperty_ properties propertyNames \_ ptype fieldName _ -> do
            rendered <- renderType ptype
            line $ "let " <> fieldName <> ": " <> rendered
    line "}"

renderTopLevelExtensions :: String -> IRType -> Doc Unit
renderTopLevelExtensions topLevelName topLevelType = do
    blank

    topLevelRendered <- renderType topLevelType
    extensionType <- case topLevelType of
        IRArray t -> ("Array where Element == " <> _) <$> renderType t
        IRMap t -> ("Dictionary where Key == String, Value == " <> _) <$> renderType t
        _ -> pure topLevelRendered

    line $ "extension " <> extensionType <> " {"
    indent do
        line $ "init?(fromString json: String, using encoding: String.Encoding = .utf8) {"
        indent do
            line "guard let data = json.data(using: encoding) else { return nil }"
            line "self.init(fromData: data)"
        line "}"
        blank
        line $ "init?(fromData data: Data) {"
        indent do
            line "guard let json = try? JSONSerialization.jsonObject(with: data, options: []) else { return nil }"
            line "self.init(fromAny: json)"
        line "}"

        case topLevelType of
            IRArray _ ->  do
                blank
                line $ "init?(fromAny untyped: Any) {"
                indent do
                    convertCode <- convertAny topLevelType "untyped"
                    line $ "guard let elements = " <> convertCode <> " else { return nil }"
                    line $ "self.init(elements)"
                line "}"
            IRMap _ -> do
                blank
                line $ "init?(fromAny untyped: Any) {"
                indent do
                    convertCode <- convertAny topLevelType "untyped"
                    line $ "guard let elements = " <> convertCode <> " else { return nil }"
                    line $ "self.init()"
                    line $ "elements.forEach { self[$0.key] = $0.value }"
                line "}"
            _ -> pure unit

        blank
        line $ "var jsonData: Data? {"
        indent do
            convertCode <- convertToAny topLevelType "self"
            line $ "let json = " <> convertCode
            line "return try? JSONSerialization.data(withJSONObject: json, options: [])"
        line "}"

        blank
        line $ "var jsonString: String? {"
        indent do
            line $ "guard let data = self.jsonData else { return nil }"
            line $ "return String(data: data, encoding: .utf8)"
        line "}"

    line "}"

renderClassExtension :: String -> Map String IRType -> Doc Unit
renderClassExtension className properties = do
    let forbidden = keywords <> ["jsonUntyped", "json"]
    let propertyNames = makePropertyNames properties "" forbidden
    line $ "extension " <> className <> " {"
    indent do
        line $ "init?(fromAny jsonUntyped: Any) {"
        indent do
            line "guard let json = jsonUntyped as? [String: Any] else { return nil }"
            let forbiddenForUntyped = forbidden <> (A.fromFoldable $ M.keys propertyNames)
            let untypedNames = makePropertyNames properties "Untyped" forbiddenForUntyped
            let forbiddenForConverted = forbiddenForUntyped <> (A.fromFoldable $ M.keys untypedNames)
            let convertedNames = makePropertyNames properties "Converted" forbiddenForConverted
            forEachProperty_ properties untypedNames \pname ptype untypedName _ -> do
                when (canBeNull ptype) do
                    line $ "let " <> untypedName <> " = removeNSNull(json[\"" <> stringEscape pname <> "\"])"
            unless (M.isEmpty properties) do
                line "guard"
                indent do
                    forEachProperty_ properties untypedNames \pname ptype untypedName isLast -> do
                        let convertedName = lookupName pname convertedNames
                        unless (canBeNull ptype) do
                            line $ "let " <> untypedName <> " = removeNSNull(json[\"" <> stringEscape pname <> "\"]),"
                        convertCode <- convertAny ptype untypedName
                        line $ "let " <> convertedName <> " = " <> convertCode <> (if isLast then "" else ",")
                    line "else { return nil }"
            forEachProperty_ properties propertyNames \pname _ fieldName _ -> do
                let convertedName = lookupName pname convertedNames
                line $ "self." <> fieldName <> " = " <> convertedName
        line "}"
        blank
        line "func toJSON() -> Any {"
        indent do
            line "var dict = [String: Any]()"
            forEachProperty_ properties propertyNames \pname ptype fieldName _ -> do
                convertCode <- convertToAny ptype ("self." <> fieldName)
                line $ "dict[\"" <> stringEscape pname <> "\"] = " <> convertCode
            line "return dict"
        line "}"
    line "}"

forEachProperty_ :: Map String IRType -> Map String String -> (String -> IRType -> String -> Boolean -> Doc Unit) -> Doc Unit
forEachProperty_ properties propertyNames f =
    let propertyArray = M.toUnfoldable properties :: Array _
        lastIndex = A.length propertyArray - 1
    in
        forWithIndex_ propertyArray \i (Tuple pname ptype) -> do
            let fieldName = lookupName pname propertyNames
            f pname ptype fieldName (i == lastIndex)

makePropertyNames :: Map String IRType -> String -> Array String -> Map String String
makePropertyNames properties suffix forbidden =
    transformPropertyNames (fieldNamer suffix) otherField forbidden properties
    where
        fieldNamer :: String -> Namer String
        fieldNamer suffix = simpleNamer \name -> swiftNameStyle false name <> suffix

        otherField :: String -> String
        otherField name = "other" <> capitalize name

renderUnionDefinition :: String -> Set IRType -> Doc Unit
renderUnionDefinition unionName unionTypes = do
    let { element: emptyOrNull, rest: nonNullTypes } = removeElement (_ == IRNull) unionTypes
    line $ "enum " <> unionName <> " {"
    indent do
        for_ nonNullTypes \typ -> do
            name <- caseName typ
            rendered <- renderType typ
            line $ "case " <> name <> "(" <> rendered <> ")"
        case emptyOrNull of
            Just t -> do
                name <- caseName t
                line $ "case " <> name
            Nothing -> pure unit
    line "}"

renderUnionExtension :: String -> Set IRType -> Doc Unit
renderUnionExtension unionName unionTypes = do
    let { element: emptyOrNull, rest: nonNullTypes } = removeElement (_ == IRNull) unionTypes
    line $ "extension " <> unionName <> " {"
    indent do
        line $ "static func fromJson(_ v: Any) -> " <> unionName <> "? {"
        indent do
            case emptyOrNull of
                Just t -> do
                    name <- caseName t
                    line "guard let v = removeNSNull(v)"
                    line "else {"
                    indent do
                        line $ "return " <> unionName <> "." <> name
                    line "}"
                Nothing -> pure unit
            when (S.member IRBool unionTypes) do
                renderCase IRBool
            when (S.member IRInteger unionTypes) do
                renderCase IRInteger
            for_ (S.difference nonNullTypes $ S.fromFoldable [IRBool, IRInteger]) \typ -> do
                renderCase typ
            line "return nil"
        line "}"
        blank
        line $ "func toJSON() -> Any {"
        indent do
            line $ "switch self {"
            for_ unionTypes \typ -> do
                name <- caseName typ
                let letString = if typ == IRNull then "" else "(let x)"
                line $ "case ." <> name <> letString <> ":"
                indent do
                    convertCode <- convertToAny typ "x"
                    line $ "return " <> convertCode
            line "}"
        line "}"
    line "}"
    where
    renderCase :: IRType -> Doc Unit
    renderCase t = do
        convertCode <- convertAny t "v"
        line $ "if let x = " <> convertCode <> " {"
        indent do
            name <- caseName t
            line $ "return " <> unionName <> "." <> name <> "(x)"
        line "}"

caseName :: IRType -> Doc String
caseName t = swiftNameStyle false <$> getTypeNameForUnion t


Fix bug in FFI user options loading code

module Neodoc.Options where

import Prelude
import Data.Maybe (Maybe(..), maybe, fromMaybe)
import Data.Either (Either(..), fromRight)
import Data.Foreign (F, Foreign)
import Data.Foreign as F
import Data.Foreign.Class as F
import Data.Foreign.Index as F
import Data.Foreign.Index ((!))
import Data.Foreign.Class
import Data.Foreign.Extra as F
import Control.Monad.Eff.Exception (Error, throwException, error, EXCEPTION)
import Control.Monad.Eff
import Neodoc.Spec
import Neodoc.Data.EmptyableLayout
import Neodoc.Data.UsageLayout
import Neodoc.Data.SolvedLayout
import Neodoc.Solve.Error
import Neodoc.Solve (SolveOptions)
import Neodoc.ArgParser.Options as ArgParser
import Neodoc.Env (Env(), unwrapEnv)
import Neodoc.SpecConversions (fromEmptyableSpec, toEmptyableSpec)
import Unsafe.Coerce

foreign import data JSCALLBACK :: !

type JsCallbackEff = (jsCallback :: JSCALLBACK, err :: EXCEPTION)

type Argv = Array String
newtype NeodocOptions = NeodocOptions {
  argv         :: Maybe Argv   -- ^ override argv. Defaults to `process.argv`
, env          :: Maybe Env    -- ^ override env.  Defaults to `process.env`
, optionsFirst :: Boolean      -- ^ enable "option-first"
, dontExit     :: Boolean      -- ^ don't exit the process upon failure
, smartOptions :: Boolean      -- ^ parse singleton groups as opts if possible
, stopAt       :: Array String -- ^ stop parsing at these custom EOA markers
, requireFlags :: Boolean      -- ^ do not ignore missing flags
, laxPlacement :: Boolean      -- ^ allow positionals/commands to be appear anywhere
, version      :: Maybe String -- ^ the version string to display
, versionFlags :: Array String -- ^ list of flags that trigger 'version'
, helpFlags    :: Array String -- ^ list of flags that trigger 'help'
, repeatableOptions :: Boolean -- ^ options are always allowed to repeat
, transforms   :: {
    presolve :: ∀ eff. Either
      (Array (Spec UsageLayout -> Eff JsCallbackEff (Spec UsageLayout)))
      (Array (Spec UsageLayout -> Either SolveError (Spec UsageLayout)))
  , postsolve :: ∀ eff. Either
      (Array (Spec SolvedLayout -> Eff JsCallbackEff (Spec SolvedLayout)))
      (Array (Spec SolvedLayout -> Either SolveError (Spec SolvedLayout)))
  }
}

defaultOptions :: NeodocOptions
defaultOptions = NeodocOptions _defaults

_defaults = {
  argv:         Nothing
, env:          Nothing
, optionsFirst: false
, dontExit:     false
, smartOptions: false
, stopAt:       []
, requireFlags: false
, laxPlacement: false
, version:      Nothing
, versionFlags: [ "--version" ]
, helpFlags:    [ "--help"    ]
, transforms:   { presolve: Right [], postsolve: Right [] }
, repeatableOptions: false
}

instance isForeign :: IsForeign NeodocOptions where
  read v = NeodocOptions <$> do
    { argv:         _
    , env:          _
    , optionsFirst: _
    , dontExit:     _
    , smartOptions: _
    , stopAt:       _
    , requireFlags: _
    , laxPlacement: _
    , version:      _
    , versionFlags: _
    , helpFlags:    _
    , transforms:   _
    , repeatableOptions: _
    }
      <$> readArgv         v
      <*> readEnv          v
      <*> readOptionsFirst v
      <*> readDontExit     v
      <*> readSmartOptions v
      <*> readStopAt       v
      <*> readRequireFlags v
      <*> readLaxPlacement v
      <*> readVersion      v
      <*> readVersionFlags v
      <*> readHelpFlags    v
      <*> readTransforms   v
      <*> readRepeatOptions v

    where
    readArgv          = _maybe "argv"
    readEnv v         = (unwrapEnv <$> _) <$> F.readPropMaybe "env" v
    readOptionsFirst  = _readBool "optionsFirst"      _defaults.optionsFirst
    readDontExit      = _readBool "dontExit"          _defaults.dontExit
    readSmartOptions  = _readBool "smartOptions"      _defaults.smartOptions
    readRequireFlags  = _readBool "requireFlags"      _defaults.requireFlags
    readLaxPlacement  = _readBool "laxPlacement"      _defaults.laxPlacement
    readRepeatOptions = _readBool "repeatableOptions" _defaults.repeatableOptions
    readVersion       = _maybe    "version"
    readStopAt        = _default  "stopAt"            _defaults.stopAt
    readVersionFlags  = _default  "versionFlags"      _defaults.versionFlags
    readHelpFlags     = _default  "helpFlags"         _defaults.helpFlags
    readTransforms v = do
      transforms :: Foreign <- F.defaultIfUndefined "transforms" (F.toForeign {}) v
      { presolve: _, postsolve: _ }
        <$> readPresolveTransforms transforms
        <*> readPostsolveTransforms transforms
      where
      readPresolveTransforms v = do
        -- note: we trust these are functions for now.
        callbacks :: Array Foreign <- F.defaultIfUndefined "presolve" [] v
        pure $ Left $ callbacks <#> \fn ->
          \(spec :: Spec UsageLayout) ->
            let spec' = (unsafeCoerce fn) (F.write $ toEmptyableSpec spec)
             in case fromEmptyableSpec <$> (F.read spec' :: Either _ (Spec (EmptyableLayout UsageLayoutArg))) of
                  Left e  -> throwException $ error $ show e
                  Right s -> pure s
      readPostsolveTransforms v = do
        -- note: we trust these are functions for now.
        callbacks :: Array Foreign <- F.defaultIfUndefined "postsolve" [] v
        pure $ Left $ callbacks <#> \fn ->
          \(spec :: Spec SolvedLayout) ->
            let spec' = (unsafeCoerce fn) (F.write $ toEmptyableSpec spec)
             in case fromEmptyableSpec <$> (F.read spec' :: Either _ (Spec (EmptyableLayout SolvedLayoutArg))) of
                  Left e  -> throwException $ error $ show e
                  Right s -> pure s
    _maybe           = F.readPropMaybe
    _default         = F.defaultIfUndefined
    _readBool k d v  = F.isTruthy <$> _default k (F.truthy d) v

module Neodoc.Options where

import Prelude
import Data.Maybe (Maybe(..), maybe, fromMaybe)
import Data.Either (Either(..), fromRight)
import Data.Foreign (F, Foreign)
import Data.Foreign as F
import Data.Foreign.Class as F
import Data.Foreign.Index as F
import Data.Foreign.Index ((!))
import Data.Foreign.Class
import Data.Foreign.Extra as F
import Control.Monad.Eff.Exception (Error, throwException, error, EXCEPTION)
import Control.Monad.Eff
import Neodoc.Spec
import Neodoc.Data.EmptyableLayout
import Neodoc.Data.UsageLayout
import Neodoc.Data.SolvedLayout
import Neodoc.Solve.Error
import Neodoc.Solve (SolveOptions)
import Neodoc.ArgParser.Options as ArgParser
import Neodoc.Env (Env(), unwrapEnv)
import Neodoc.SpecConversions (fromEmptyableSpec, toEmptyableSpec)
import Unsafe.Coerce

foreign import data JSCALLBACK :: !

type JsCallbackEff = (jsCallback :: JSCALLBACK, err :: EXCEPTION)

type Argv = Array String
newtype NeodocOptions = NeodocOptions {
  argv         :: Maybe Argv   -- ^ override argv. Defaults to `process.argv`
, env          :: Maybe Env    -- ^ override env.  Defaults to `process.env`
, optionsFirst :: Boolean      -- ^ enable "option-first"
, dontExit     :: Boolean      -- ^ don't exit the process upon failure
, smartOptions :: Boolean      -- ^ parse singleton groups as opts if possible
, stopAt       :: Array String -- ^ stop parsing at these custom EOA markers
, requireFlags :: Boolean      -- ^ do not ignore missing flags
, laxPlacement :: Boolean      -- ^ allow positionals/commands to be appear anywhere
, version      :: Maybe String -- ^ the version string to display
, versionFlags :: Array String -- ^ list of flags that trigger 'version'
, helpFlags    :: Array String -- ^ list of flags that trigger 'help'
, repeatableOptions :: Boolean -- ^ options are always allowed to repeat
, transforms   :: {
    presolve :: ∀ eff. Either
      (Array (Spec UsageLayout -> Eff JsCallbackEff (Spec UsageLayout)))
      (Array (Spec UsageLayout -> Either SolveError (Spec UsageLayout)))
  , postsolve :: ∀ eff. Either
      (Array (Spec SolvedLayout -> Eff JsCallbackEff (Spec SolvedLayout)))
      (Array (Spec SolvedLayout -> Either SolveError (Spec SolvedLayout)))
  }
}

defaultOptions :: NeodocOptions
defaultOptions = NeodocOptions _defaults

_defaults = {
  argv:         Nothing
, env:          Nothing
, optionsFirst: false
, dontExit:     false
, smartOptions: false
, stopAt:       []
, requireFlags: false
, laxPlacement: false
, version:      Nothing
, versionFlags: [ "--version" ]
, helpFlags:    [ "--help"    ]
, transforms:   { presolve: Right [], postsolve: Right [] }
, repeatableOptions: false
}

instance isForeign :: IsForeign NeodocOptions where
  read v = NeodocOptions <$> do
    { argv:         _
    , env:          _
    , optionsFirst: _
    , dontExit:     _
    , smartOptions: _
    , stopAt:       _
    , requireFlags: _
    , laxPlacement: _
    , version:      _
    , versionFlags: _
    , helpFlags:    _
    , transforms:   _
    , repeatableOptions: _
    }
      <$> readArgv         v
      <*> readEnv          v
      <*> readOptionsFirst v
      <*> readDontExit     v
      <*> readSmartOptions v
      <*> readStopAt       v
      <*> readRequireFlags v
      <*> readLaxPlacement v
      <*> readVersion      v
      <*> readVersionFlags v
      <*> readHelpFlags    v
      <*> readTransforms   v
      <*> readRepeatOptions v

    where
    readArgv          = _maybe "argv"
    readEnv v         = (unwrapEnv <$> _) <$> F.readPropMaybe "env" v
    readOptionsFirst  = _readBool "optionsFirst"      _defaults.optionsFirst
    readDontExit      = _readBool "dontExit"          _defaults.dontExit
    readSmartOptions  = _readBool "smartOptions"      _defaults.smartOptions
    readRequireFlags  = _readBool "requireFlags"      _defaults.requireFlags
    readLaxPlacement  = _readBool "laxPlacement"      _defaults.laxPlacement
    readRepeatOptions = _readBool "repeatableOptions" _defaults.laxPlacement
    readVersion       = _maybe    "version"
    readStopAt        = _default  "stopAt"            _defaults.stopAt
    readVersionFlags  = _default  "versionFlags"      _defaults.versionFlags
    readHelpFlags     = _default  "helpFlags"         _defaults.helpFlags
    readTransforms v = do
      transforms :: Foreign <- F.defaultIfUndefined "transforms" (F.toForeign {}) v
      { presolve: _, postsolve: _ }
        <$> readPresolveTransforms transforms
        <*> readPostsolveTransforms transforms
      where
      readPresolveTransforms v = do
        -- note: we trust these are functions for now.
        callbacks :: Array Foreign <- F.defaultIfUndefined "presolve" [] v
        pure $ Left $ callbacks <#> \fn ->
          \(spec :: Spec UsageLayout) ->
            let spec' = (unsafeCoerce fn) (F.write $ toEmptyableSpec spec)
             in case fromEmptyableSpec <$> (F.read spec' :: Either _ (Spec (EmptyableLayout UsageLayoutArg))) of
                  Left e  -> throwException $ error $ show e
                  Right s -> pure s
      readPostsolveTransforms v = do
        -- note: we trust these are functions for now.
        callbacks :: Array Foreign <- F.defaultIfUndefined "postsolve" [] v
        pure $ Left $ callbacks <#> \fn ->
          \(spec :: Spec SolvedLayout) ->
            let spec' = (unsafeCoerce fn) (F.write $ toEmptyableSpec spec)
             in case fromEmptyableSpec <$> (F.read spec' :: Either _ (Spec (EmptyableLayout SolvedLayoutArg))) of
                  Left e  -> throwException $ error $ show e
                  Right s -> pure s
    _maybe           = F.readPropMaybe
    _default         = F.defaultIfUndefined
    _readBool k d v  = F.isTruthy <$> _default k (F.truthy d) v


[CSM-219] Add remaining client endpoints

module Daedalus.ClientApi where

import Prelude
import Daedalus.BackendApi as B
import Control.Monad.Eff.Exception (error)
import Control.Monad.Eff (Eff)
import Control.Monad.Eff.Exception (EXCEPTION)
import Control.Monad.Eff.Ref (newRef, REF)
import Control.Promise (Promise, fromAff)
import Daedalus.Types (getProfileLocale, mkCAddress, mkCCoin, mkCWalletMeta, mkCTxId, mkCTxMeta, mkCCurrency, mkCProfile, mkCWalletInit, mkCWalletRedeem, mkBackupPhrase, mkCInitialized, mkCPaperVendWalletRedeem, mkCPassPhrase, mkCWalletSetInit)
import Daedalus.WS (WSConnection(WSNotConnected), mkWSState, ErrorCb, NotifyCb, openConn)
import Data.Bifunctor (lmap)
import Data.Argonaut (Json)
import Data.Argonaut.Generic.Aeson (encodeJson, decodeJson)
import Data.String.Base64 as B64
import Data.Base58 as B58
import Data.Array as A
import Data.String (length, stripSuffix, Pattern (..))
import Data.Maybe (isJust, maybe, Maybe (..))
import Data.Function.Eff (EffFn1, mkEffFn1, EffFn2, mkEffFn2, EffFn4, mkEffFn4, EffFn5, mkEffFn5, EffFn3, mkEffFn3, EffFn6, mkEffFn6, EffFn7, mkEffFn7)
import Network.HTTP.Affjax (AJAX)
import WebSocket (WEBSOCKET)
import Control.Monad.Error.Class (throwError)
import Data.Either (either)
import Daedalus.Crypto as Crypto

--------------------------------------------------------------------------------
-- TEST ------------------------------------------------------------------------

-- | Resets wallet database (metadata) and wallets/keys
-- This should be used only in testing
-- Arguments:
-- Returns:
-- Example in nodejs:
testReset :: forall eff. Eff (ajax :: AJAX | eff) (Promise Unit)
testReset = fromAff B.testReset

--------------------------------------------------------------------------------
-- Wallet Sets ---------------------------------------------------------------------

-- | Gets specified wallet set
-- Arguments: wallet set id/hash
-- Returns json representation of requested wallet set
-- Example in nodejs:
--
getWalletSet :: forall eff. EffFn1 (ajax :: AJAX | eff) String (Promise Json)
getWalletSet = mkEffFn1 $ fromAff <<< map encodeJson <<< B.getWalletSet <<< mkCAddress

-- | Gets all wallet sets
-- Arguments:
-- Returns json representation of all wallet sets
-- Example in nodejs:
--
getWalletSets :: forall eff. Eff (ajax :: AJAX | eff) (Promise Json)
getWalletSets = fromAff $ map encodeJson B.getWalletSets

-- | Creates a new wallet set.
-- Arguments: wallet set name, mnemonics, spending password (set to empty string if you don't want to set password)
-- Returns json representation of created wallet set
-- Example in nodejs:
--
newWalletSet :: forall eff . EffFn3 (ajax :: AJAX, crypto :: Crypto.CRYPTO | eff) String String String
  (Promise Json)
newWalletSet = mkEffFn3 \wSetName mnemonic spendingPassword -> fromAff <<< map encodeJson <<<
    either throwError (B.newWalletSet $ mkCPassPhrase spendingPassword) $ mkCWalletSetInit wSetName mnemonic

-- TODO: note that restoreWalletSet and newWalletSet are the same. They will be unified in future

-- | Restores a new wallet set.
-- Arguments: wallet set name, mnemonics, spending password (set to empty string if you don't want to set password
-- Returns json representation of restored wallet set
-- Example in nodejs:
--
restoreWalletSet :: forall eff. EffFn3 (ajax :: AJAX | eff) String String String (Promise Json)
restoreWalletSet = mkEffFn3 \wSetName mnemonic spendingPassword -> fromAff <<< map encodeJson <<< either throwError (B.restoreWalletSet $ mkCPassPhrase spendingPassword) $ mkCWalletSetInit wSetName mnemonic

-- | Rename a wallet set.
-- Arguments: wallet set id/hash, name
-- Returns json representation of renamed wallet set
-- Example in nodejs:
--
renameWalletSet :: forall eff. EffFn2 (ajax :: AJAX | eff) String String (Promise Json)
renameWalletSet = mkEffFn2 \wSetId name -> fromAff <<< map encodeJson $ B.renameWalletSet (mkCAddress wSetId) name

-- | Import a wallet set.
-- Arguments: file path to the wallet set on a filesystem, spending password (set to empty string if you don't want to set password)
-- Returns json representation of imported wallet set
-- Example in nodejs:
--
importWalletSet :: forall eff. EffFn2 (ajax :: AJAX | eff) String String (Promise Json)
importWalletSet = mkEffFn2 \filePath spendingPassword -> fromAff <<< map encodeJson $ B.importWalletSet (mkCPassPhrase spendingPassword) filePath

-- | Rename a wallet set.
-- Arguments: wallet set id/hash, old spending password (set to empty string if there is no password), new spending password (set to empty string if you want to remove password)
-- Returns json representation of renamed wallet set
-- Example in nodejs:
--
changeWalletSetPass :: forall eff. EffFn3 (ajax :: AJAX | eff) String String String (Promise Json)
changeWalletSetPass = mkEffFn3 \wSetId oldPass newPass -> fromAff <<< map encodeJson $ B.changeWalletSetPass (mkCAddress wSetId) (mkCPassPhrase oldPass) (mkCPassPhrase newPass)

--------------------------------------------------------------------------------
-- Wallets ---------------------------------------------------------------------

-- | Get a wallet.
-- Arguments: wallet object/identifier
-- Returns json representation of a wallet
-- Example in nodejs:
--
getWallet :: forall eff. EffFn1 (ajax :: AJAX | eff) Json (Promise Json)
getWallet = mkEffFn1 $ fromAff <<< map encodeJson <<< either (throwError <<< error) B.getWallet <<< decodeJson

-- | Get all wallets.
-- Arguments:
-- Returns json representation of all wallet sets
-- Example in nodejs:
--
getWallets :: forall eff. Eff (ajax :: AJAX | eff) (Promise Json)
getWallets = fromAff $ map encodeJson $ B.getWallets Nothing

-- | Get wallets from specific wallet set.
-- Arguments: address/hash/id of a wallet set
-- Returns json representation of wallets within given wallet set id
-- Example in nodejs:
--
getSetWallets :: forall eff. EffFn1 (ajax :: AJAX | eff) String (Promise Json)
getSetWallets = mkEffFn1 $ fromAff <<< map encodeJson <<< B.getWallets <<< Just <<< mkCAddress

-- | Get meta information from given wallet
-- Arguments: wallet object/identifier, type, currency, name, assurance, unit
-- Returns json representation of wallets within given wallet id
-- Example in nodejs:
--
updateWallet :: forall eff. EffFn6 (ajax :: AJAX | eff) Json String String String String Int (Promise Json)
updateWallet = mkEffFn6 \wId wType wCurrency wName wAssurance wUnit -> fromAff <<< map encodeJson <<<
    either (throwError <<< error)
        (flip B.updateWallet $ mkCWalletMeta wType wCurrency wName wAssurance wUnit)
        $ decodeJson wId

-- | Creates a new wallet.
-- Arguments: address/hash/id of a wallet set, type, currency, name, mnemonics, spending password (if empty string is given, wallet will be created with no spending password)
-- Returns json representation of newly created wallet
-- Example in nodejs:
--
newWallet :: forall eff . EffFn6 (ajax :: AJAX | eff) String String String String String String
  (Promise Json)
newWallet = mkEffFn6 \wSetId wType wCurrency wName mnemonic spendingPassword -> fromAff <<< map encodeJson <<<
    B.newWallet (mkCPassPhrase spendingPassword) $ mkCWalletInit wType wCurrency wName (mkCAddress wSetId)

-- | Deletes a wallet.
-- Arguments: wallet object/identifier
-- Returns:
-- Example in nodejs:
--
deleteWallet :: forall eff. EffFn1 (ajax :: AJAX | eff) Json (Promise Unit)
deleteWallet = mkEffFn1 $ fromAff <<< either (throwError <<< error) B.deleteWallet <<< decodeJson

--------------------------------------------------------------------------------
-- Accounts ------------------------------------------------------------------

-- | Creates a new wallet.
-- Arguments: wallet set, type, currency, name, mnemonics, spending password (if empty string is given, wallet will be created with no spending password)
-- Returns json representation of newly created wallet
-- Example in nodejs:
--
newAccount :: forall eff . EffFn2 (ajax :: AJAX | eff) Json String
  (Promise Json)
newAccount = mkEffFn2 \wId spendingPassword -> fromAff <<< map encodeJson <<<
    either (throwError <<< error) (B.newAccount $ mkCPassPhrase spendingPassword) $ decodeJson wId

--------------------------------------------------------------------------------
-- Addresses ------------------------------------------------------------------

-- | Checks is some string correct representation of a valid address
-- Arguments: currency for which we are checking address, string representation of an address to check
-- Returns true if address is valid in specific currency or false otherwise
-- Example in nodejs:
--
isValidAddress :: forall eff. EffFn2 (ajax :: AJAX | eff) String String (Promise Boolean)
isValidAddress = mkEffFn2 \currency -> fromAff <<< B.isValidAddress (mkCCurrency currency)

--------------------------------------------------------------------------------
-- Profiles --------------------------------------------------------------------

-- | Gets user locale.
-- Arguments:
-- Returns users locale
-- Example in nodejs:
--
getLocale :: forall eff. Eff (ajax :: AJAX | eff) (Promise String)
getLocale = fromAff $ getProfileLocale <$> B.getProfile

-- | Sets user locale.
-- Arguments: new user locale
-- Returns users locale
-- Example in nodejs:
--
updateLocale :: forall eff. EffFn1 (ajax :: AJAX | eff) String (Promise String)
updateLocale = mkEffFn1 \locale -> fromAff <<< map getProfileLocale <<< B.updateProfile $ mkCProfile locale

--------------------------------------------------------------------------------
-- Transactions ----------------------------------------------------------------

-- | Creates a new payment.
-- Arguments: wallet object/id, address id/hash, amount to send, spending password (leave empty string if you don't want to use spending password)
-- Returns a created transaction
-- Example in nodejs:
--
newPayment :: forall eff. EffFn4 (ajax :: AJAX | eff) Json String String String (Promise Json)
newPayment = mkEffFn4 \wFrom addrTo amount spendingPassword -> fromAff <<< map encodeJson $ either (throwError <<< error) id
    $ B.newPayment
    <$> (pure $ mkCPassPhrase spendingPassword)
    <*> (decodeJson wFrom)
    <*> (pure $ mkCAddress addrTo)
    <*> (pure $ mkCCoin amount)

-- | Creates a new payment.
-- Arguments: wallet object/id, address id/hash, amount to send, currency, title, description, spending password (leave empty string if you don't want to use spending password)
-- Returns a created transaction
-- Example in nodejs:
--
newPaymentExtended :: forall eff. EffFn7 (ajax :: AJAX | eff) Json String String String String String String (Promise Json)
newPaymentExtended = mkEffFn7 \wFrom addrTo amount curr title desc spendingPassword -> fromAff <<< map encodeJson $ either (throwError <<< error) id
    $ B.newPaymentExtended
    <$> (pure $ mkCPassPhrase spendingPassword)
    <*> (decodeJson wFrom)
    <*> (pure $ mkCAddress addrTo)
    <*> (pure $ mkCCoin amount)
    <*> (pure $ mkCCurrency curr)
    <*> (pure title)
    <*> (pure desc)

-- | Updates transaction meta data.
-- Arguments: wallet object/id, transaction id/hash, currency, title, description, date
-- Returns
-- Example in nodejs:
--
updateTransaction :: forall eff. EffFn6 (ajax :: AJAX | eff) Json String String String String Number (Promise Unit)
updateTransaction = mkEffFn6 \wId ctxId ctmCurrency ctmTitle ctmDescription ctmDate -> fromAff <<< either (throwError <<< error) id
    $ B.updateTransaction
    <$> (decodeJson wId)
    <*> (pure $ mkCTxId ctxId)
    <*> (pure $ mkCTxMeta ctmCurrency ctmTitle ctmDescription ctmDate)

-- | Get transactions of specified wallet
-- Arguments: wallet object/id, skip, limit
-- Returns a pair of transacts retrieved from the history and total number of transactions in specified wallet
-- Example in nodejs:
--
getHistory :: forall eff. EffFn3 (ajax :: AJAX | eff) Json Int Int (Promise Json)
getHistory = mkEffFn3 \wId skip limit -> fromAff <<< map encodeJson $ either (throwError <<< error) id
    $ B.getHistory
    <$> (decodeJson wId)
    <*> (pure $ Just skip)
    <*> (pure $ Just limit)

-- | Gets transactions that match some search criteria
-- Arguments: wallet object/id, search string, skip, limit
-- Returns a pair of transacts retrieved from the history and total number of transactions in specified wallet
-- Example in nodejs:
--
searchHistory :: forall eff. EffFn4 (ajax :: AJAX | eff) Json String Int Int (Promise Json)
searchHistory = mkEffFn4 \wId search skip limit -> fromAff <<< map encodeJson $ either (throwError <<< error) id
    $ B.searchHistory
    <$> (decodeJson wId)
    <*> pure Nothing
    <*> (pure search)
    <*> (pure $ Just skip)
    <*> (pure $ Just limit)

-- | Gets transactions that match some search criteria
-- Arguments: wallet object/id, narrow the search to account hash/id, search string, skip, limit
-- Returns a pair of transacts retrieved from the history and total number of transactions in specified wallet/account
-- Example in nodejs:
--
searchAccountHistory :: forall eff. EffFn5 (ajax :: AJAX | eff) Json String String Int Int (Promise Json)
searchAccountHistory = mkEffFn5 \wId account search skip limit -> fromAff <<< map encodeJson $ either (throwError <<< error) id
    $ B.searchHistory
    <$> (decodeJson wId)
    <*> (pure $ Just $ mkCAddress account)
    <*> (pure search)
    <*> (pure $ Just skip)
    <*> (pure $ Just limit)

--------------------------------------------------------------------------------
-- Updates ---------------------------------------------------------------------

nextUpdate :: forall eff. Eff (ajax :: AJAX | eff) (Promise Json)
nextUpdate = fromAff $ map encodeJson B.nextUpdate

applyUpdate :: forall eff. Eff (ajax :: AJAX | eff) (Promise Unit)
applyUpdate = fromAff B.applyUpdate

--------------------------------------------------------------------------------
-- Redemptions -----------------------------------------------------------------

redeemAda :: forall eff. EffFn3 (ajax :: AJAX, crypto :: Crypto.CRYPTO | eff) String Json String (Promise Json)
redeemAda = mkEffFn3 \seed wId spendingPassword -> fromAff <<< map encodeJson <<< either (throwError <<< error) id
    $ B.redeemAda (mkCPassPhrase spendingPassword)
    <$> mkCWalletRedeem seed
    <$> decodeJson wId

redeemAdaPaperVend :: forall eff. EffFn4 (ajax :: AJAX, crypto :: Crypto.CRYPTO | eff) String String Json String (Promise Json)
redeemAdaPaperVend = mkEffFn4 \seed mnemonic wId spendingPassword -> fromAff <<< map encodeJson <<< either throwError (B.redeemAdaPaperVend $ mkCPassPhrase spendingPassword) $ mkCPaperVendWalletRedeem seed mnemonic =<< lmap error (decodeJson wId)

-- Valid redeem code is base64 encoded 32byte data
-- NOTE: this method handles both base64 and base64url base on rfc4648: see more https://github.com/menelaos/purescript-b64/blob/59e2e9189358a4c8e3eef8662ca281906844e783/src/Data/String/Base64.purs#L182
isValidRedemptionKey :: String -> Boolean
isValidRedemptionKey code = either (const false) (const $ endsWithEqual && 44 == length code) $ B64.decode code
  where
    -- Because it is 32byte base64 encoded
    endsWithEqual = isJust $ stripSuffix (Pattern "=") code

-- Valid paper vend key is base58 encoded 32byte data
isValidPaperVendRedemptionKey :: String -> Boolean
isValidPaperVendRedemptionKey code = maybe false ((==) 32 <<< A.length) $ B58.decode code

--------------------------------------------------------------------------------
-- Reporting ---------------------------------------------------------------------

reportInit :: forall eff. EffFn2 (ajax :: AJAX, crypto :: Crypto.CRYPTO | eff) Int Int (Promise Unit)
reportInit = mkEffFn2 \total -> fromAff <<< B.reportInit <<< mkCInitialized total

--------------------------------------------------------------------------------
-- Settings ---------------------------------------------------------------------

blockchainSlotDuration :: forall eff. Eff (ajax :: AJAX | eff) (Promise Int)
blockchainSlotDuration = fromAff B.blockchainSlotDuration

systemVersion :: forall eff. Eff (ajax :: AJAX | eff) (Promise Json)
systemVersion = fromAff $ map encodeJson B.systemVersion

syncProgress :: forall eff. Eff (ajax :: AJAX | eff) (Promise Json)
syncProgress = fromAff $ map encodeJson B.syncProgress

--------------------------------------------------------------------------------
-- Mnemonics ---------------------------------------------------------------------

generateMnemonic :: forall eff. Eff (crypto :: Crypto.CRYPTO | eff) String
generateMnemonic = Crypto.generateMnemonic

-- | bip39.validateMnemonic and has at least len words
isValidMnemonic :: forall eff. EffFn2 (crypto :: Crypto.CRYPTO | eff) Int String Boolean
isValidMnemonic = mkEffFn2 \len -> pure <<< either (const false) (const true) <<< mkBackupPhrase len

--------------------------------------------------------------------------------
-- Websockets ---------------------------------------------------------------------

notify :: forall eff. EffFn2 (ref :: REF, ws :: WEBSOCKET, err :: EXCEPTION | eff) (NotifyCb eff) (ErrorCb eff) Unit
notify = mkEffFn2 \messageCb errorCb -> do
    -- TODO (akegalj) grab global (mutable) state of  here
    -- instead of creating newRef
    conn <- newRef WSNotConnected
    openConn $ mkWSState conn messageCb errorCb

module Daedalus.ClientApi where

import Prelude
import Daedalus.BackendApi as B
import Control.Monad.Eff.Exception (error)
import Control.Monad.Eff (Eff)
import Control.Monad.Eff.Exception (EXCEPTION)
import Control.Monad.Eff.Ref (newRef, REF)
import Control.Promise (Promise, fromAff)
import Daedalus.Types (getProfileLocale, mkCAddress, mkCCoin, mkCWalletMeta, mkCTxId, mkCTxMeta, mkCCurrency, mkCProfile, mkCWalletInit, mkCWalletRedeem, mkBackupPhrase, mkCInitialized, mkCPaperVendWalletRedeem, mkCPassPhrase, mkCWalletSetInit)
import Daedalus.WS (WSConnection(WSNotConnected), mkWSState, ErrorCb, NotifyCb, openConn)
import Data.Argonaut (Json)
import Data.Argonaut.Generic.Aeson (encodeJson, decodeJson)
import Data.String.Base64 as B64
import Data.Base58 as B58
import Data.Array as A
import Data.String (length, stripSuffix, Pattern (..))
import Data.Maybe (isJust, maybe, Maybe (..))
import Data.Function.Eff (EffFn1, mkEffFn1, EffFn2, mkEffFn2, EffFn4, mkEffFn4, EffFn5, mkEffFn5, EffFn3, mkEffFn3, EffFn6, mkEffFn6, EffFn7, mkEffFn7)
import Network.HTTP.Affjax (AJAX)
import WebSocket (WEBSOCKET)
import Control.Monad.Error.Class (throwError)
import Data.Either (either)
import Daedalus.Crypto as Crypto

--------------------------------------------------------------------------------
-- TEST ------------------------------------------------------------------------

-- | Resets wallet database (metadata) and wallets/keys
-- This should be used only in testing
-- Arguments:
-- Returns:
-- Example in nodejs:
testReset :: forall eff. Eff (ajax :: AJAX | eff) (Promise Unit)
testReset = fromAff B.testReset

--------------------------------------------------------------------------------
-- Wallet Sets ---------------------------------------------------------------------

-- | Gets specified wallet set
-- Arguments: wallet set id/hash
-- Returns json representation of requested wallet set
-- Example in nodejs:
--
getWalletSet :: forall eff. EffFn1 (ajax :: AJAX | eff) String (Promise Json)
getWalletSet = mkEffFn1 $ fromAff <<< map encodeJson <<< B.getWalletSet <<< mkCAddress

-- | Gets all wallet sets
-- Arguments:
-- Returns json representation of all wallet sets
-- Example in nodejs:
--
getWalletSets :: forall eff. Eff (ajax :: AJAX | eff) (Promise Json)
getWalletSets = fromAff $ map encodeJson B.getWalletSets

-- | Creates a new wallet set.
-- Arguments: wallet set name, mnemonics, spending password (set to empty string if you don't want to set password)
-- Returns json representation of created wallet set
-- Example in nodejs:
--
newWalletSet :: forall eff . EffFn3 (ajax :: AJAX, crypto :: Crypto.CRYPTO | eff) String String String
  (Promise Json)
newWalletSet = mkEffFn3 \wSetName mnemonic spendingPassword -> fromAff <<< map encodeJson <<<
    either throwError (B.newWalletSet $ mkCPassPhrase spendingPassword) $ mkCWalletSetInit wSetName mnemonic

-- TODO: note that restoreWalletSet and newWalletSet are the same. They will be unified in future

-- | Restores a new wallet set.
-- Arguments: wallet set name, mnemonics, spending password (set to empty string if you don't want to set password
-- Returns json representation of restored wallet set
-- Example in nodejs:
--
restoreWalletSet :: forall eff. EffFn3 (ajax :: AJAX | eff) String String String (Promise Json)
restoreWalletSet = mkEffFn3 \wSetName mnemonic spendingPassword -> fromAff <<< map encodeJson <<< either throwError (B.restoreWalletSet $ mkCPassPhrase spendingPassword) $ mkCWalletSetInit wSetName mnemonic

-- | Rename a wallet set.
-- Arguments: wallet set id/hash, name
-- Returns json representation of renamed wallet set
-- Example in nodejs:
--
renameWalletSet :: forall eff. EffFn2 (ajax :: AJAX | eff) String String (Promise Json)
renameWalletSet = mkEffFn2 \wSetId name -> fromAff <<< map encodeJson $ B.renameWalletSet (mkCAddress wSetId) name

-- | Import a wallet set.
-- Arguments: file path to the wallet set on a filesystem, spending password (set to empty string if you don't want to set password)
-- Returns json representation of imported wallet set
-- Example in nodejs:
--
importWalletSet :: forall eff. EffFn2 (ajax :: AJAX | eff) String String (Promise Json)
importWalletSet = mkEffFn2 \filePath spendingPassword -> fromAff <<< map encodeJson $ B.importWalletSet (mkCPassPhrase spendingPassword) filePath

-- | Rename a wallet set.
-- Arguments: wallet set id/hash, old spending password (set to empty string if there is no password), new spending password (set to empty string if you want to remove password)
-- Returns json representation of renamed wallet set
-- Example in nodejs:
--
changeWalletSetPass :: forall eff. EffFn3 (ajax :: AJAX | eff) String String String (Promise Json)
changeWalletSetPass = mkEffFn3 \wSetId oldPass newPass -> fromAff <<< map encodeJson $ B.changeWalletSetPass (mkCAddress wSetId) (mkCPassPhrase oldPass) (mkCPassPhrase newPass)

--------------------------------------------------------------------------------
-- Wallets ---------------------------------------------------------------------

-- | Get a wallet.
-- Arguments: wallet object/identifier
-- Returns json representation of a wallet
-- Example in nodejs:
--
getWallet :: forall eff. EffFn1 (ajax :: AJAX | eff) Json (Promise Json)
getWallet = mkEffFn1 $ fromAff <<< map encodeJson <<< either (throwError <<< error) B.getWallet <<< decodeJson

-- | Get all wallets.
-- Arguments:
-- Returns json representation of all wallet sets
-- Example in nodejs:
--
getWallets :: forall eff. Eff (ajax :: AJAX | eff) (Promise Json)
getWallets = fromAff $ map encodeJson $ B.getWallets Nothing

-- | Get wallets from specific wallet set.
-- Arguments: address/hash/id of a wallet set
-- Returns json representation of wallets within given wallet set id
-- Example in nodejs:
--
getSetWallets :: forall eff. EffFn1 (ajax :: AJAX | eff) String (Promise Json)
getSetWallets = mkEffFn1 $ fromAff <<< map encodeJson <<< B.getWallets <<< Just <<< mkCAddress

-- | Get meta information from given wallet
-- Arguments: wallet object/identifier, type, currency, name, assurance, unit
-- Returns json representation of wallets within given wallet id
-- Example in nodejs:
--
updateWallet :: forall eff. EffFn6 (ajax :: AJAX | eff) Json String String String String Int (Promise Json)
updateWallet = mkEffFn6 \wId wType wCurrency wName wAssurance wUnit -> fromAff <<< map encodeJson <<<
    either (throwError <<< error)
        (flip B.updateWallet $ mkCWalletMeta wType wCurrency wName wAssurance wUnit)
        $ decodeJson wId

-- | Creates a new wallet.
-- Arguments: address/hash/id of a wallet set, type, currency, name, mnemonics, spending password (if empty string is given, wallet will be created with no spending password)
-- Returns json representation of newly created wallet
-- Example in nodejs:
--
newWallet :: forall eff . EffFn6 (ajax :: AJAX | eff) String String String String String String
  (Promise Json)
newWallet = mkEffFn6 \wSetId wType wCurrency wName mnemonic spendingPassword -> fromAff <<< map encodeJson <<<
    B.newWallet (mkCPassPhrase spendingPassword) $ mkCWalletInit wType wCurrency wName (mkCAddress wSetId)

-- | Deletes a wallet.
-- Arguments: wallet object/identifier
-- Returns:
-- Example in nodejs:
--
deleteWallet :: forall eff. EffFn1 (ajax :: AJAX | eff) Json (Promise Unit)
deleteWallet = mkEffFn1 $ fromAff <<< either (throwError <<< error) B.deleteWallet <<< decodeJson

--------------------------------------------------------------------------------
-- Accounts ------------------------------------------------------------------

-- | Creates a new wallet.
-- Arguments: wallet set, type, currency, name, mnemonics, spending password (if empty string is given, wallet will be created with no spending password)
-- Returns json representation of newly created wallet
-- Example in nodejs:
--
newAccount :: forall eff . EffFn2 (ajax :: AJAX | eff) Json String
  (Promise Json)
newAccount = mkEffFn2 \wId spendingPassword -> fromAff <<< map encodeJson <<<
    either (throwError <<< error) (B.newAccount $ mkCPassPhrase spendingPassword) $ decodeJson wId

--------------------------------------------------------------------------------
-- Addresses ------------------------------------------------------------------

-- | Checks is some string correct representation of a valid address
-- Arguments: currency for which we are checking address, string representation of an address to check
-- Returns true if address is valid in specific currency or false otherwise
-- Example in nodejs:
--
isValidAddress :: forall eff. EffFn2 (ajax :: AJAX | eff) String String (Promise Boolean)
isValidAddress = mkEffFn2 \currency -> fromAff <<< B.isValidAddress (mkCCurrency currency)

--------------------------------------------------------------------------------
-- Profiles --------------------------------------------------------------------

-- | Gets user locale.
-- Arguments:
-- Returns users locale
-- Example in nodejs:
--
getLocale :: forall eff. Eff (ajax :: AJAX | eff) (Promise String)
getLocale = fromAff $ getProfileLocale <$> B.getProfile

-- | Sets user locale.
-- Arguments: new user locale
-- Returns users locale
-- Example in nodejs:
--
updateLocale :: forall eff. EffFn1 (ajax :: AJAX | eff) String (Promise String)
updateLocale = mkEffFn1 \locale -> fromAff <<< map getProfileLocale <<< B.updateProfile $ mkCProfile locale

--------------------------------------------------------------------------------
-- Transactions ----------------------------------------------------------------

-- | Creates a new payment.
-- Arguments: wallet object/id, address id/hash, amount to send, spending password (leave empty string if you don't want to use spending password)
-- Returns a created transaction
-- Example in nodejs:
--
newPayment :: forall eff. EffFn4 (ajax :: AJAX | eff) Json String String String (Promise Json)
newPayment = mkEffFn4 \wFrom addrTo amount spendingPassword -> fromAff <<< map encodeJson $ either (throwError <<< error) id
    $ B.newPayment
    <$> (pure $ mkCPassPhrase spendingPassword)
    <*> (decodeJson wFrom)
    <*> (pure $ mkCAddress addrTo)
    <*> (pure $ mkCCoin amount)

-- | Creates a new payment.
-- Arguments: wallet object/id, address id/hash, amount to send, currency, title, description, spending password (leave empty string if you don't want to use spending password)
-- Returns a created transaction
-- Example in nodejs:
--
newPaymentExtended :: forall eff. EffFn7 (ajax :: AJAX | eff) Json String String String String String String (Promise Json)
newPaymentExtended = mkEffFn7 \wFrom addrTo amount curr title desc spendingPassword -> fromAff <<< map encodeJson $ either (throwError <<< error) id
    $ B.newPaymentExtended
    <$> (pure $ mkCPassPhrase spendingPassword)
    <*> (decodeJson wFrom)
    <*> (pure $ mkCAddress addrTo)
    <*> (pure $ mkCCoin amount)
    <*> (pure $ mkCCurrency curr)
    <*> (pure title)
    <*> (pure desc)

-- | Updates transaction meta data.
-- Arguments: wallet object/id, transaction id/hash, currency, title, description, date
-- Returns
-- Example in nodejs:
--
updateTransaction :: forall eff. EffFn6 (ajax :: AJAX | eff) Json String String String String Number (Promise Unit)
updateTransaction = mkEffFn6 \wId ctxId ctmCurrency ctmTitle ctmDescription ctmDate -> fromAff <<< either (throwError <<< error) id
    $ B.updateTransaction
    <$> (decodeJson wId)
    <*> (pure $ mkCTxId ctxId)
    <*> (pure $ mkCTxMeta ctmCurrency ctmTitle ctmDescription ctmDate)

-- | Get transactions of specified wallet
-- Arguments: wallet object/id, skip, limit
-- Returns a pair of transacts retrieved from the history and total number of transactions in specified wallet
-- Example in nodejs:
--
getHistory :: forall eff. EffFn3 (ajax :: AJAX | eff) Json Int Int (Promise Json)
getHistory = mkEffFn3 \wId skip limit -> fromAff <<< map encodeJson $ either (throwError <<< error) id
    $ B.getHistory
    <$> (decodeJson wId)
    <*> (pure $ Just skip)
    <*> (pure $ Just limit)

-- | Gets transactions that match some search criteria
-- Arguments: wallet object/id, search string, skip, limit
-- Returns a pair of transacts retrieved from the history and total number of transactions in specified wallet
-- Example in nodejs:
--
searchHistory :: forall eff. EffFn4 (ajax :: AJAX | eff) Json String Int Int (Promise Json)
searchHistory = mkEffFn4 \wId search skip limit -> fromAff <<< map encodeJson $ either (throwError <<< error) id
    $ B.searchHistory
    <$> (decodeJson wId)
    <*> pure Nothing
    <*> (pure search)
    <*> (pure $ Just skip)
    <*> (pure $ Just limit)

-- | Gets transactions that match some search criteria
-- Arguments: wallet object/id, narrow the search to account hash/id, search string, skip, limit
-- Returns a pair of transacts retrieved from the history and total number of transactions in specified wallet/account
-- Example in nodejs:
--
searchAccountHistory :: forall eff. EffFn5 (ajax :: AJAX | eff) Json Json String Int Int (Promise Json)
searchAccountHistory = mkEffFn5 \wId account search skip limit -> fromAff <<< map encodeJson $ either (throwError <<< error) id
    $ B.searchHistory
    <$> (decodeJson wId)
    <*> (pure $ Just $ mkCAddress account)
    <*> (pure search)
    <*> (pure $ Just skip)
    <*> (pure $ Just limit)

-- getWallets :: forall eff. Eff (ajax :: AJAX | eff) (Promise Json)
-- getWallets = fromAff $ map encodeJson B.getWallets
--
-- getWallet :: forall eff. EffFn1 (ajax :: AJAX | eff) String (Promise Json)
-- getWallet = mkEffFn1 $ fromAff <<< map encodeJson <<< B.getWallet <<< mkCAddress
--
-- getHistory :: forall eff. EffFn3 (ajax :: AJAX | eff) String Int Int (Promise Json)
-- getHistory = mkEffFn3 \addr skip limit -> fromAff <<< map encodeJson $
--     B.getHistory
--         (mkCAddress addr)
--         skip
--         limit
--
-- searchHistory :: forall eff. EffFn4 (ajax :: AJAX | eff) String String Int Int (Promise Json)
-- searchHistory = mkEffFn4 \addr search skip limit -> fromAff <<< map encodeJson $
--     B.searchHistory
--         (mkCAddress addr)
--         search
--         skip
--         limit
--
-- send :: forall eff. EffFn4 (ajax :: AJAX | eff) String String String String (Promise Json)
-- send = mkEffFn4 \addrFrom addrTo amount spendingPassword -> fromAff <<< map encodeJson $
--     B.send
--         (mkCPassPhrase spendingPassword)
--         (mkCAddress addrFrom)
--         (mkCAddress addrTo)
--         (mkCCoin amount)
--
-- sendExtended :: forall eff. EffFn7 (ajax :: AJAX | eff) String String String String String String String (Promise Json)
-- sendExtended = mkEffFn7 \addrFrom addrTo amount curr title desc spendingPassword -> fromAff <<< map encodeJson $
--     B.sendExtended
--         (mkCPassPhrase spendingPassword)
--         (mkCAddress addrFrom)
--         (mkCAddress addrTo)
--         (mkCCoin amount)
--         (mkCCurrency curr)
--         title
--         desc
--
-- generateMnemonic :: forall eff. Eff (crypto :: Crypto.CRYPTO | eff) String
-- generateMnemonic = Crypto.generateMnemonic
--
-- -- | bip39.validateMnemonic and has at least len words
-- isValidMnemonic :: forall eff. EffFn2 (crypto :: Crypto.CRYPTO | eff) Int String Boolean
-- isValidMnemonic = mkEffFn2 \len -> pure <<< either (const false) (const true) <<< mkBackupPhrase len
--
-- newWallet :: forall eff . EffFn5 (ajax :: AJAX, crypto :: Crypto.CRYPTO | eff) String String String String String
--   (Promise Json)
-- newWallet = mkEffFn5 \wType wCurrency wName mnemonic spendingPassword -> fromAff <<< map encodeJson <<<
--     either throwError (B.newWallet $ mkCPassPhrase spendingPassword) $ mkCWalletInit wType wCurrency wName mnemonic
--
-- -- NOTE: https://issues.serokell.io/issue/DAE-33#comment=96-1798
-- -- Daedalus.ClientApi.newWallet(
-- --     'CWTPersonal'
-- --   , 'ADA'
-- --   , 'wallet name'
-- --   , function(mnemonics) {
-- --     // if this function finishes we will send request for wallet
-- --     // creation to the backend. That means user validated and
-- --     // stored mnemonics.
-- --     // if an exception is thrown new wallet request will be aborted
-- --     // and promise should return thrown error
-- --     if(userSavedMnemonics) {
-- --       // do nothing
-- --     } else {
-- --       throw new Error("Wallet canceled")
-- --     }
-- --   }
-- --   )()
-- --   .then(function(value) {
-- --     console.log('SUCCESS', value);
-- --   }, function(reason) {
-- --     console.log('ERROR', reason);
-- --   })
-- -- newWalletDeprecated :: forall eff . Fn4 String String String (EffFn1 (err :: EXCEPTION | eff) String Unit)
-- --   (Eff(ajax :: AJAX, crypto :: Crypto.CRYPTO | eff) (Promise Json))
-- -- newWalletDeprecated = mkFn4 \wType wCurrency wName wConfirmMnemonic -> fromAff $ map encodeJson $ do
-- --
-- --     mnemonic <- liftEff Crypto.generateMnemonic
-- --     -- FIXME: @jens how did we satisfy this with notify? I am having trouble again
-- --     isConfirmed <- liftEff' $ unsafeInterleaveEff $ runEffFn1 wConfirmMnemonic mnemonic
-- --     either throwError B.newWallet $ do
-- --         isConfirmed
-- --         mkCWalletInit wType wCurrency wName mnemonic
--
-- updateWallet :: forall eff. EffFn6 (ajax :: AJAX | eff) String String String String String Int (Promise Json)
-- updateWallet = mkEffFn6 \addr wType wCurrency wName wAssurance wUnit -> fromAff <<< map encodeJson <<<
--     B.updateWallet
--         (mkCAddress addr)
--         $ mkCWalletMeta wType wCurrency wName wAssurance wUnit
--
-- updateTransaction :: forall eff. EffFn6 (ajax :: AJAX | eff) String String String String String Number (Promise Unit)
-- updateTransaction = mkEffFn6 \addr ctxId ctmCurrency ctmTitle ctmDescription ctmDate -> fromAff <<<
--     B.updateTransaction
--         (mkCAddress addr)
--         (mkCTxId ctxId)
--         $ mkCTxMeta ctmCurrency ctmTitle ctmDescription ctmDate
--
-- deleteWallet :: forall eff. EffFn1 (ajax :: AJAX | eff) String (Promise Unit)
-- deleteWallet = mkEffFn1 $ fromAff <<< B.deleteWallet <<< mkCAddress
--
-- isValidAddress :: forall eff. EffFn2 (ajax :: AJAX | eff) String String (Promise Boolean)
-- isValidAddress = mkEffFn2 \currency -> fromAff <<< B.isValidAddress (mkCCurrency currency)
--
-- notify :: forall eff. EffFn2 (ref :: REF, ws :: WEBSOCKET, err :: EXCEPTION | eff) (NotifyCb eff) (ErrorCb eff) Unit
-- notify = mkEffFn2 \messageCb errorCb -> do
--     -- TODO (akegalj) grab global (mutable) state of  here
--     -- instead of creating newRef
--     conn <- newRef WSNotConnected
--     openConn $ mkWSState conn messageCb errorCb
--
-- blockchainSlotDuration :: forall eff. Eff (ajax :: AJAX | eff) (Promise Int)
-- blockchainSlotDuration = fromAff B.blockchainSlotDuration
--
-- restoreWallet :: forall eff. EffFn5 (ajax :: AJAX | eff) String String String String String (Promise Json)
-- restoreWallet = mkEffFn5 \wType wCurrency wName spendingPassword -> fromAff <<< map encodeJson <<< either throwError (B.restoreWallet $ mkCPassPhrase spendingPassword) <<< mkCWalletInit wType wCurrency wName
--
--
-- nextUpdate :: forall eff. Eff (ajax :: AJAX | eff) (Promise Json)
-- nextUpdate = fromAff $ map encodeJson B.nextUpdate
--
-- applyUpdate :: forall eff. Eff (ajax :: AJAX | eff) (Promise Unit)
-- applyUpdate = fromAff B.applyUpdate
--
-- systemVersion :: forall eff. Eff (ajax :: AJAX | eff) (Promise Json)
-- systemVersion = fromAff $ map encodeJson B.systemVersion
--
-- redeemAda :: forall eff. EffFn2 (ajax :: AJAX, crypto :: Crypto.CRYPTO | eff) String String (Promise Json)
-- redeemAda = mkEffFn2 \seed -> fromAff <<< map encodeJson <<< B.redeemAda <<< mkCWalletRedeem seed
--
-- redeemAdaPaperVend :: forall eff. EffFn3 (ajax :: AJAX, crypto :: Crypto.CRYPTO | eff) String String String (Promise Json)
-- redeemAdaPaperVend = mkEffFn3 \seed mnemonic -> fromAff <<< map encodeJson <<< either throwError B.redeemAdaPaperVend <<< mkCPaperVendWalletRedeem seed mnemonic
--
-- reportInit :: forall eff. EffFn2 (ajax :: AJAX, crypto :: Crypto.CRYPTO | eff) Int Int (Promise Unit)
-- reportInit = mkEffFn2 \total -> fromAff <<< B.reportInit <<< mkCInitialized total
--
-- importKey :: forall eff. EffFn1 (ajax :: AJAX | eff) String (Promise Json)
-- importKey = mkEffFn1 $ fromAff <<< map encodeJson <<< B.importKey
--
-- syncProgress :: forall eff. Eff (ajax :: AJAX | eff) (Promise Json)
-- syncProgress = fromAff $ map encodeJson B.syncProgress
--
-- -- Valid redeem code is base64 encoded 32byte data
-- -- NOTE: this method handles both base64 and base64url base on rfc4648: see more https://github.com/menelaos/purescript-b64/blob/59e2e9189358a4c8e3eef8662ca281906844e783/src/Data/String/Base64.purs#L182
-- isValidRedemptionKey :: String -> Boolean
-- isValidRedemptionKey code = either (const false) (const $ endsWithEqual && 44 == length code) $ B64.decode code
--   where
--     -- Because it is 32byte base64 encoded
--     endsWithEqual = isJust $ stripSuffix (Pattern "=") code
--
-- -- Valid paper vend key is base58 encoded 32byte data
-- isValidPaperVendRedemptionKey :: String -> Boolean
-- isValidPaperVendRedemptionKey code = maybe false ((==) 32 <<< A.length) $ B58.decode code


Don't print on cosole

Don't print on cosole

module App.Events where

import Prelude

import App.Backend (loadTopics)
import App.Config (config)
import App.Routes (Route)
import App.State (State(..))
import App.Types (Topic)
import Data.Maybe (Maybe(..))

import Network.HTTP.Affjax (AJAX)
import Pux (EffModel, noEffects, onlyEffects)

data Event = PageView Route
           | LoadTopics
           | TopicsLoaded (Array Topic)

type AppEffects fx = (ajax :: AJAX | fx)

foldp :: ∀ fx. Event -> State -> EffModel State Event (AppEffects fx)
foldp (PageView route) (State st) =
  noEffects $ State st { route = route, loaded = true }

foldp LoadTopics s =
  onlyEffects s [ Just <$> TopicsLoaded <$> loadTopics config ]

foldp (TopicsLoaded topics) s@(State st) =
  noEffects $ State st { topics = topics }

module App.Events where

import Prelude

import App.Backend (loadTopics)
import App.Config (config)
import App.Routes (Route)
import App.State (State(..))
import App.Types (Topic)
import Control.Monad.Aff.Console (CONSOLE, log)
import Data.Maybe (Maybe(..))
import Data.String (joinWith)
import Network.HTTP.Affjax (AJAX)
import Pux (EffModel, noEffects, onlyEffects)

data Event = PageView Route
           | LoadTopics
           | TopicsLoaded (Array Topic)

type AppEffects fx = (ajax :: AJAX, console :: CONSOLE | fx)

foldp :: ∀ fx. Event -> State -> EffModel State Event (AppEffects fx)
foldp (PageView route) (State st) =
  noEffects $ State st { route = route, loaded = true }

foldp LoadTopics s =
  onlyEffects s [ Just <$> TopicsLoaded <$> loadTopics config ]

foldp (TopicsLoaded topics) s@(State st) =
  { state: State st { topics = topics }
  , effects: [ (log $ joinWith "; " (map show topics)) *> pure Nothing ]
  }