Created renderable class

Created renderable class

module Graphics.Three.Object3D where

import Graphics.Three.Math.Vector
import Graphics.Three.Types
import Graphics.Three.Util
import Control.Monad.Eff

import qualified Graphics.Three.Camera as C
import qualified Graphics.Three.Material as M
import qualified Graphics.Three.Geometry as G

foreign import data Mesh :: *
foreign import data Line :: *

class Object3D a where
    getPosition :: a -> ThreeEff Vector3
    setPosition :: a -> Number -> Number -> Number -> ThreeEff Unit
    {--getRotationEuler :: forall eff. a -> Number -> Number -> Number -> Eff (three :: Three | eff) --}
    {--setRotationEuler :: forall eff. a -> Number -> Number -> Number -> Eff (three :: Three | eff) Unit--}
    rotateIncrement :: a -> Number -> Number -> Number -> ThreeEff Unit

instance object3DMesh :: Object3D Mesh where
    getPosition     = unsafeGetPosition
    setPosition     = unsafeSetPosition
    rotateIncrement = unsafeRotateIncrement

instance object3DLine :: Object3D Line where
    getPosition     = unsafeGetPosition
    setPosition     = unsafeSetPosition
    rotateIncrement = unsafeRotateIncrement

instance object3DCamera :: Object3D C.Camera where
    getPosition     = unsafeGetPosition
    setPosition     = unsafeSetPosition
    rotateIncrement = unsafeRotateIncrement

class Renderable a where
    getGeometry :: a -> ThreeEff G.Geometry
    getMaterial :: a -> ThreeEff M.Material

instance renderableMesh :: Renderable Mesh where
    getGeometry     = unsafeGetGeometry
    getMaterial     = unsafeGetMaterial

instance renderableLine :: Renderable Line where
    getGeometry     = unsafeGetGeometry
    getMaterial     = unsafeGetMaterial

data LineType = LineStrip | LinePiece

instance showLineType :: Show LineType where
    show LineStrip = "LineStrip"
    show LinePiece = "LinePiece"

createMesh :: G.Geometry -> M.Material -> ThreeEff Mesh
createMesh = ffi ["geometry", "material", ""] "new THREE.Mesh(geometry, material)"

createLine :: G.Geometry -> M.Material -> LineType -> ThreeEff Line
createLine g m t = create g m $ show t
    where
        create = ffi ["geometry", "material", "lineType", ""] "new THREE.Line(geometry, material)"

unsafeGetPosition = ffi ["object", ""] "object.position"
unsafeSetPosition = fpi ["object", "x", "y", "z", ""] "object.position.set(x, y, z)"
unsafeGetGeometry = ffi ["object", ""] "object.geometry"
unsafeGetMaterial = ffi ["object", ""] "object.material"
unsafeRotateIncrement = fpi ["object", "x", "y", "z", ""]
    "object.rotation.x += x; object.rotation.y += y; object.rotation.z += z;"

module Graphics.Three.Object3D where

import Graphics.Three.Math.Vector
import Graphics.Three.Types
import Graphics.Three.Util
import Control.Monad.Eff

import qualified Graphics.Three.Camera as C
import qualified Graphics.Three.Material as M
import qualified Graphics.Three.Geometry as G

foreign import data Mesh :: *
foreign import data Line :: *

class Object3D a where
    getPosition :: a -> ThreeEff Vector3
    setPosition :: a -> Number -> Number -> Number -> ThreeEff Unit
    getGeometry :: a -> ThreeEff G.Geometry
    getMaterial :: a -> ThreeEff M.Material
    {--getRotationEuler :: forall eff. a -> Number -> Number -> Number -> Eff (three :: Three | eff) --}
    {--setRotationEuler :: forall eff. a -> Number -> Number -> Number -> Eff (three :: Three | eff) Unit--}
    rotateIncrement :: a -> Number -> Number -> Number -> ThreeEff Unit

instance object3DMesh :: Object3D Mesh where
    getPosition     = unsafeGetPosition
    setPosition     = unsafeSetPosition
    getGeometry     = unsafeGetGeometry
    getMaterial     = unsafeGetMaterial
    rotateIncrement = unsafeRotateIncrement

instance object3DLine :: Object3D Line where
    getPosition     = unsafeGetPosition
    setPosition     = unsafeSetPosition
    getGeometry     = unsafeGetGeometry
    getMaterial     = unsafeGetMaterial
    rotateIncrement = unsafeRotateIncrement

instance object3DCamera :: Object3D C.Camera where
    getPosition     = unsafeGetPosition
    setPosition     = unsafeSetPosition
    getGeometry     = unsafeGetGeometry
    getMaterial     = unsafeGetMaterial
    rotateIncrement = unsafeRotateIncrement

data LineType = LineStrip | LinePiece

instance showLineType :: Show LineType where
    show LineStrip = "LineStrip"
    show LinePiece = "LinePiece"

createMesh :: G.Geometry -> M.Material -> ThreeEff Mesh
createMesh = ffi ["geometry", "material", ""] "new THREE.Mesh(geometry, material)"

createLine :: G.Geometry -> M.Material -> LineType -> ThreeEff Line
createLine g m t = create g m $ show t
    where
        create = ffi ["geometry", "material", "lineType", ""] "new THREE.Line(geometry, material)"

unsafeGetPosition = ffi ["object", ""] "object.position"
unsafeSetPosition = fpi ["object", "x", "y", "z", ""] "object.position.set(x, y, z)"
unsafeGetGeometry = ffi ["object", ""] "object.geometry"
unsafeGetMaterial = ffi ["object", ""] "object.material"
unsafeRotateIncrement = fpi ["object", "x", "y", "z", ""]
    "object.rotation.x += x; object.rotation.y += y; object.rotation.z += z;"


Add more tests with other types

Add more tests with other types

Signed-off-by: Joern Bernhardt <7b85a41a628204b76aba4326273a3ccc74bd009a@campudus.com>

module Test.Main where

import Prelude

import Control.Monad.Eff (Eff)
import Control.Monad.Eff.Console (CONSOLE)
import Control.Monad.Eff.Random (RANDOM)
import Control.Monad.Eff.Exception (EXCEPTION)
import Control.Monad.Aff.AVar
import Control.Monad.Free (Free)

-- import Test.Unit (suite, test, TestF)
-- import Test.Unit.Console (TESTOUTPUT)
--
-- import Test.Unit.Main (runTest)
-- import Test.Unit.Assert as Assert

import Test.QuickCheck

import Data.List
import Data.Maybe
import Main (sum, length)

-- main :: forall e. Eff (console :: CONSOLE, testOutput :: TESTOUTPUT, avar :: AVAR | e) Unit
main = mainQuickCheck

-- Using QuickCheck
mainQuickCheck = do
  quickCheck \(xs :: List Int) -> length xs >= 0
  quickCheck \(xs :: List Char) -> length xs >= 0
  quickCheck \(xs :: List String) -> length xs >= 0
  quickCheck \(xs :: List Boolean) -> length xs >= 0

-- Using Test.Unit
-- mainUnit :: forall e. Eff (console :: CONSOLE, testOutput :: TESTOUTPUT, avar :: AVAR | e) Unit
-- mainUnit = runTest do
--   sumTest
--   lengthTest
--
-- sumTest :: forall e. Free (TestF e) Unit
-- sumTest = suite "sum" do
--   test "should be zero for empty list" do
--     Assert.assert "empty array should be 0" $ (sum Nil) == 0
--   test "should be the same value for a single element" do
--     Assert.assert "0 for [0]" $ (sum (0 : Nil)) == 0
--     Assert.assert "1 for [1]" $ (sum (1 : Nil)) == 1
--     Assert.assert "-210 for [-210]" $ (sum (-210 : Nil)) == -210
--     Assert.assert "93152 for [93152]" $ (sum (93152 : Nil)) == 93152
--   test "should sum up multiple values of variable length" do
--     Assert.assert "0 for [0, 0, 0, 0, 0]" $ (sum (0 : 0 : 0 : 0 : 0 : Nil)) == 0
--     Assert.assert "1 for [1, 2, 3, 4]" $ (sum (1 : 2 : 3 : 4 : Nil)) == 10
--     Assert.assert "77 for [6, 1, 15, 52, 3]" $ (sum (6 : 1 : 15 : 52 : 3 : Nil)) == 77
--
-- lengthTest :: forall e. Free (TestF e) Unit
-- lengthTest = suite "length" do
--   test "should be zero for empty list" do
--     Assert.assert "empty list should be 0" $ (length Nil) == 0
--   test "should be the same value for a single element" do
--     Assert.assert "1 for [0]" $ (length (0 : Nil)) == 1
--     Assert.assert "1 for [-123]" $ (length (-123 : Nil)) == 1
--     Assert.assert "1 for [[]]" $ (length ((Nil) : Nil)) == 1
--   test "should length up multiple values of variable length" do
--     Assert.assert "3 for [[1], [2], [3]]" $ (length ((1 : Nil) : (2 : Nil) : (3 : Nil) : Nil)) == 3
--     Assert.assert "3 for [[], [1], [2]]" $ (length ((Nil) : (1 : Nil) : (2 : Nil) : Nil)) == 3
--     Assert.assert "2 for [[1, 2], [3, 4]]" $ (length ((1 : 2 : Nil) : (3 : 4 : Nil) : Nil)) == 2
--

module Test.Main where

import Prelude

import Control.Monad.Eff (Eff)
import Control.Monad.Eff.Console (CONSOLE)
import Control.Monad.Eff.Random (RANDOM)
import Control.Monad.Eff.Exception (EXCEPTION)
import Control.Monad.Aff.AVar
import Control.Monad.Free (Free)

-- import Test.Unit (suite, test, TestF)
-- import Test.Unit.Console (TESTOUTPUT)
--
-- import Test.Unit.Main (runTest)
-- import Test.Unit.Assert as Assert

import Test.QuickCheck

import Data.List
import Data.Maybe
import Main (sum, length)

-- main :: forall e. Eff (console :: CONSOLE, testOutput :: TESTOUTPUT, avar :: AVAR | e) Unit
main = mainQuickCheck

-- Using QuickCheck
mainQuickCheck = do
  quickCheck \(xs :: List Int) -> length xs >= 0

-- Using Test.Unit
-- mainUnit :: forall e. Eff (console :: CONSOLE, testOutput :: TESTOUTPUT, avar :: AVAR | e) Unit
-- mainUnit = runTest do
--   sumTest
--   lengthTest
--
-- sumTest :: forall e. Free (TestF e) Unit
-- sumTest = suite "sum" do
--   test "should be zero for empty list" do
--     Assert.assert "empty array should be 0" $ (sum Nil) == 0
--   test "should be the same value for a single element" do
--     Assert.assert "0 for [0]" $ (sum (0 : Nil)) == 0
--     Assert.assert "1 for [1]" $ (sum (1 : Nil)) == 1
--     Assert.assert "-210 for [-210]" $ (sum (-210 : Nil)) == -210
--     Assert.assert "93152 for [93152]" $ (sum (93152 : Nil)) == 93152
--   test "should sum up multiple values of variable length" do
--     Assert.assert "0 for [0, 0, 0, 0, 0]" $ (sum (0 : 0 : 0 : 0 : 0 : Nil)) == 0
--     Assert.assert "1 for [1, 2, 3, 4]" $ (sum (1 : 2 : 3 : 4 : Nil)) == 10
--     Assert.assert "77 for [6, 1, 15, 52, 3]" $ (sum (6 : 1 : 15 : 52 : 3 : Nil)) == 77
--
-- lengthTest :: forall e. Free (TestF e) Unit
-- lengthTest = suite "length" do
--   test "should be zero for empty list" do
--     Assert.assert "empty list should be 0" $ (length Nil) == 0
--   test "should be the same value for a single element" do
--     Assert.assert "1 for [0]" $ (length (0 : Nil)) == 1
--     Assert.assert "1 for [-123]" $ (length (-123 : Nil)) == 1
--     Assert.assert "1 for [[]]" $ (length ((Nil) : Nil)) == 1
--   test "should length up multiple values of variable length" do
--     Assert.assert "3 for [[1], [2], [3]]" $ (length ((1 : Nil) : (2 : Nil) : (3 : Nil) : Nil)) == 3
--     Assert.assert "3 for [[], [1], [2]]" $ (length ((Nil) : (1 : Nil) : (2 : Nil) : Nil)) == 3
--     Assert.assert "2 for [[1, 2], [3, 4]]" $ (length ((1 : 2 : Nil) : (3 : 4 : Nil) : Nil)) == 2
--


Use multiline strings and reduce runtime `require`s

-- | This module provides the FFI definitions required to render HTML documents
-- | using the `virtual-dom` library.

module Halogen.Internal.VirtualDOM
  ( VTree()
  , Patch()
  , Props()
  , emptyProps
  , prop
  , handlerProp
  , initProp
  , finalizerProp
  , createElement
  , diff
  , patch
  , vtext
  , vnode
  ) where

import DOM
import Data.DOM.Simple.Types

import Data.Int
import Data.Maybe
import Data.Monoid
import Data.Nullable
import Data.Function

import Control.Monad.Eff
import Control.Monad.ST

-- | Virtual DOM nodes
data VTree

-- | Patch sets, used to update the DOM
data Patch

-- | Property collections
data Props

foreign import emptyProps
  "var emptyProps = {}" :: Props

-- | Create a property from a key/value pair.
-- |
-- | Properties named `data-*` will be added as attributes, and any other properties will
-- | be set directly.
-- |
-- | Users should use caution when creating custom attributes, and understand how they will
-- | be added to the DOM here.
foreign import prop
  """
  function prop(key, value) {
    var props = {};
    props[key] = value;
    return props;
  }
  """ :: forall value. Fn2 String value Props

-- | Create a property from an event handler
foreign import handlerProp
  """
  function handlerProp(key, f) {
    var props = {};
    var Hook = function () {};
    Hook.prototype.callback = function (e) {
      f(e)();
    };
    Hook.prototype.hook = function (node) {
      node.addEventListener(key, this.callback);
    };
    Hook.prototype.unhook = function (node) {
      node.removeEventListener(key, this.callback);
    };
    props['halogen-hook-' + key] = new Hook(f);
    return props;
  }
  """ :: forall eff event. Fn2 String (event -> Eff eff Unit) Props

-- | Create a property from an initializer
foreign import initProp
  """
  function initProp(f) {
    var props = {};
    var Hook = function () {};
    Hook.prototype.hook = function (node, prop, prev) {
      if (typeof prev === 'undefined') {
        f();
      };
    };
    props['halogen-init'] = new Hook(f);
    return props;
  }
  """ :: forall eff. Eff eff Unit -> Props

-- | Create a property from an finalizer
foreign import finalizerProp
  """
  function finalizerProp(f) {
    var props = {};
    var Hook = function () {};
    Hook.prototype.hook = function () { };
    Hook.prototype.unhook = function () {
      f();
    };
    props['halogen-finalizer'] = new Hook(f);
    return props;
  }
  """ :: forall eff. Eff eff Unit -> Props

foreign import concatProps
  """
  function concatProps(p1, p2) {
    var props = {};
    for (var key in p1) {
      props[key] = p1[key];
    }
    for (var key in p2) {
      props[key] = p2[key];
    }
    return props;
  }
  """ :: Fn2 Props Props Props

instance semigroupProps :: Semigroup Props where
  (<>) = runFn2 concatProps

instance monoidProps :: Monoid Props where
  mempty = emptyProps

-- | Create a DOM node from a virtual DOM tree
foreign import createElement
  """
  var createElement = (function () {
    var vcreateElement = require('virtual-dom/create-element');
    return function (vtree) {
      return vcreateElement(vtree);
    };
  }());
  """ :: VTree -> HTMLElement

-- | Calculate the differences between two virtual DOM trees
foreign import diff
  """
  var diff = (function () {
    var vdiff = require('virtual-dom/diff');
    return function (vtree1) {
      return function (vtree2) {
        return vdiff(vtree1, vtree2);
      };
    };
  }());

  """ :: VTree -> VTree -> Patch

-- | Apply a set of patches to the DOM
foreign import patch
  """
  var patch = (function () {
    var vpatch = require('virtual-dom/patch');
    return function (p) {
      return function (node) {
        return function () {
          return vpatch(node, p);
        };
      };
    };
  }());
  """ :: forall eff. Patch -> HTMLElement -> Eff (dom :: DOM | eff) HTMLElement

-- | Create a virtual DOM tree which represents a single text node
foreign import vtext
  """
  var vtext = (function () {
    var VText = require('virtual-dom/vnode/vtext');
    return function (s) {
      return new VText(s);
    };
  }());
  """ :: String -> VTree

-- | Create a virtual DOM tree which represents an element with properties
foreign import vnode
  """
  var vnode = (function () {
    var VirtualNode = require('virtual-dom/vnode/vnode');
    return function (name) {
      return function (attr) {
        return function (children) {
          var props = {
            attributes: {}
          };
          for (var key in attr) {
            if ((key.indexOf('data-') === 0) || (key === 'readonly')) {
              props.attributes[key] = attr[key];
            } else {
              props[key] = attr[key];
            }
          }
          return new VirtualNode(name, props, children);
        };
      };
    };
  }());
  """ :: String -> Props -> [VTree] -> VTree

-- | This module provides the FFI definitions required to render HTML documents
-- | using the `virtual-dom` library.

module Halogen.Internal.VirtualDOM
  ( VTree()
  , Patch()
  , Props()
  , emptyProps
  , prop
  , handlerProp
  , initProp
  , finalizerProp
  , createElement
  , diff
  , patch
  , vtext
  , vnode
  ) where

import DOM
import Data.DOM.Simple.Types

import Data.Int
import Data.Maybe
import Data.Monoid
import Data.Nullable
import Data.Function

import Control.Monad.Eff
import Control.Monad.ST

-- | Virtual DOM nodes
data VTree

-- | Patch sets, used to update the DOM
data Patch

-- | Property collections
data Props

foreign import emptyProps
  "var emptyProps = {}" :: Props

-- | Create a property from a key/value pair.
-- |
-- | Properties named `data-*` will be added as attributes, and any other properties will
-- | be set directly.
-- |
-- | Users should use caution when creating custom attributes, and understand how they will
-- | be added to the DOM here.
foreign import prop
  "function prop(key, value) {\
  \  var props = {};\
  \  props[key] = value;\
  \  return props;\
  \}" :: forall value. Fn2 String value Props

-- | Create a property from an event handler
foreign import handlerProp
  "function handlerProp(key, f) {\
  \  var props = {};\
  \  var Hook = function () {};\
  \  Hook.prototype.callback = function(e) {\
  \    f(e)();\
  \  };\
  \  Hook.prototype.hook = function(node) {\
  \    node.addEventListener(key, this.callback);\
  \  };\
  \  Hook.prototype.unhook = function(node) {\
  \    node.removeEventListener(key, this.callback);\
  \  };\
  \  props['halogen-hook-' + key] = new Hook(f);\
  \  return props;\
  \}" :: forall eff event. Fn2 String (event -> Eff eff Unit) Props

-- | Create a property from an initializer
foreign import initProp
  "function initProp(f) {\
  \  var props = {};\
  \  var Hook = function () {};\
  \  Hook.prototype.hook = function(node, prop, prev) {\
  \    if (typeof prev === 'undefined') {\
  \      f();\
  \    };\
  \  };\
  \  props['halogen-init'] = new Hook(f);\
  \  return props;\
  \}" :: forall eff. Eff eff Unit -> Props

-- | Create a property from an finalizer
foreign import finalizerProp
  "function finalizerProp(f) {\
  \  var props = {};\
  \  var Hook = function () {};\
  \  Hook.prototype.hook = function() { };\
  \  Hook.prototype.unhook = function() {\
  \    f();\
  \  };\
  \  props['halogen-finalizer'] = new Hook(f);\
  \  return props;\
  \}" :: forall eff. Eff eff Unit -> Props

foreign import concatProps
  "function concatProps(p1, p2) {\
  \  var props = {};\
  \  for (var key in p1) {\
  \    props[key] = p1[key];\
  \  }\
  \  for (var key in p2) {\
  \    props[key] = p2[key];\
  \  }\
  \  return props;\
  \}" :: Fn2 Props Props Props

instance semigroupProps :: Semigroup Props where
  (<>) = runFn2 concatProps

instance monoidProps :: Monoid Props where
  mempty = emptyProps

-- | Create a DOM node from a virtual DOM tree
foreign import createElement
  "function createElement(vtree) {\
  \  return require('virtual-dom/create-element')(vtree);\
  \}" :: VTree -> HTMLElement

-- | Calculate the differences between two virtual DOM trees
foreign import diff
  "function diff(vtree1) {\
  \  return function createElement(vtree2) {\
  \    return require('virtual-dom/diff')(vtree1, vtree2);\
  \  };\
  \}" :: VTree -> VTree -> Patch

-- | Apply a set of patches to the DOM
foreign import patch
  "function patch(p) {\
  \  return function(node) {\
  \    return function() {\
  \      return require('virtual-dom/patch')(node, p);\
  \    };\
  \  };\
  \}" :: forall eff. Patch -> HTMLElement -> Eff (dom :: DOM | eff) HTMLElement

-- | Create a virtual DOM tree which represents a single text node
foreign import vtext
  "function vtext(s) {\
  \  var VText = require('virtual-dom/vnode/vtext');\
  \  return new VText(s);\
  \}" :: String -> VTree

-- | Create a virtual DOM tree which represents an element with properties
foreign import vnode
  "function vnode(name) {\
  \  return function(attr) {\
  \    return function(children) {\
  \      var VirtualNode = require('virtual-dom/vnode/vnode');\
  \      var props = {\
  \        attributes: {}\
  \      };\
  \      for (var key in attr) {\
  \        if ((key.indexOf('data-') === 0) || (key === 'readonly')) {\
  \          props.attributes[key] = attr[key];\
  \        } else {\
  \          props[key] = attr[key];\
  \        }\
  \      }\
  \      return new VirtualNode(name, props, children);\
  \    };\
  \  };\
  \}" :: String -> Props -> [VTree] -> VTree


[CSM-403] Fix return type of import method

module Daedalus.BackendApi where

import Prelude
import Control.Monad.Eff (Eff)
import Control.Monad.Aff (Aff, makeAff)
import Control.Monad.Eff.Exception (error, Error, throwException)
import Control.Monad.Eff.Exception (EXCEPTION)
import Control.Monad.Error.Class (throwError)
import Control.Monad.Aff (Aff)
import Daedalus.Types (CId, _address, _ccoin, CAccount, CTx, CAccountMeta, CTxId, CTxMeta, _ctxIdValue, WalletError, CProfile, CAccountInit, CUpdateInfo, SoftwareVersion, CWalletRedeem, SyncProgress, CInitialized, CPassPhrase, _passPhrase, CCoin, CPaperVendWalletRedeem, Wal, CWallet, CWalletInit, walletAddressToUrl, CAccountId, CAddress, Addr, CWalletMeta)
import Data.Argonaut (Json)
import Data.Argonaut.Parser (jsonParser)
import Data.Argonaut.Generic.Aeson (decodeJson, encodeJson)
import Data.Bifunctor (bimap, lmap)
import Data.Either (either, Either(Left))
import Data.FormURLEncoded (fromArray, encode)
import Data.Generic (class Generic, gShow)
import Data.HTTP.Method (Method(GET, POST, PUT, DELETE))
import Data.Maybe (Maybe(Just))
import Data.MediaType.Common (applicationJSON)
import Data.Monoid (mempty)
import Data.String (joinWith)
import Data.Tuple (Tuple (..))
import Data.StrMap (fromFoldable)
import Daedalus.TLS (TLSOptions)
import Node.HTTP.Client (method, path, request, statusCode, statusMessage, Response, responseAsStream, headers, RequestHeaders (..), Request, requestAsStream)
import Data.Options ((:=))
import Node.Encoding (Encoding (UTF8))
import Node.Stream (onDataString, writeString, end)
import Node.HTTP (HTTP)

-- HELPERS

type URLPath = Tuple (Array String) QueryParams
type URL = String
type QueryParam = Tuple String (Maybe String)
type QueryParams = Array QueryParam
type FilePath = String

noQueryParam :: Array String -> URLPath
noQueryParam = flip Tuple mempty

queryParams :: Array String -> QueryParams -> URLPath
queryParams = Tuple

qParam :: String -> Maybe String -> QueryParam
qParam = Tuple

mkUrl :: URLPath -> URL
mkUrl (Tuple urlPath params) = joinWith "/" urlPath <> "?" <> encode (fromArray params)

backendApi :: URLPath -> URL
backendApi = mkUrl <<< lmap ((<>) ["/api"])

data ApiError
    = HTTPStatusError Response
    | JSONDecodingError String
    | ServerError WalletError

instance showApiError :: Show ApiError where
    show (HTTPStatusError res) =
        "HTTPStatusError: " <> show (statusCode res) <> " msg: " <> statusMessage res
    show (JSONDecodingError e) =
        "JSONDecodingError: " <> show e
    show (ServerError e) =
        "ServerError: " <> gShow e

-- REQUESTS HELPERS

decodeResult :: forall a eff. Generic a => String -> Either Error a
decodeResult = either (Left <<< mkJSONError) (lmap mkServerError) <<< decodeJson <=< lmap error <<< jsonParser
  where
    mkJSONError = error <<< show <<< JSONDecodingError
    mkServerError = error <<< show <<< ServerError

makeRequest :: forall eff a. (Generic a) => (Request -> Eff (http :: HTTP, err :: EXCEPTION | eff) Unit) -> TLSOptions -> URLPath -> Aff (http :: HTTP, err :: EXCEPTION | eff) a
makeRequest withReq tls urlPath = do
    -- FIXME: exceptin shouldn't happen here?
    res <- makeAff $ const $ withReq <=< request (tls <> path := backendApi urlPath)
    when (isHttpError res) $
        throwError <<< error <<< show $ HTTPStatusError res
    rawData <- makeAff $ const $ onDataString (responseAsStream res) UTF8
    either throwError pure $ decodeResult rawData
  where
    isHttpError res = statusCode res >= 400

plainRequest :: forall eff a r. (Generic a) => TLSOptions -> URLPath -> Aff (http :: HTTP, err :: EXCEPTION | eff) a
plainRequest = makeRequest $ flip end (pure unit) <<< requestAsStream

bodyRequest :: forall eff a b. (Generic a, Generic b) => TLSOptions -> URLPath -> b -> Aff (http :: HTTP, err :: EXCEPTION | eff) a
bodyRequest tls urlPath body = makeRequest flushBody (tls <> headers := reqHeaders) urlPath
  where
    flushBody req = do
        let writeStream = requestAsStream req
        writeString writeStream UTF8 (show $ encodeJson body) $ pure unit
        end writeStream $ pure unit
    -- TODO: use Data.MediaType.Common here
    reqHeaders = RequestHeaders $ fromFoldable [Tuple "Content-Type" "application/json"]

getR :: forall eff a. Generic a => TLSOptions -> URLPath -> Aff (http :: HTTP, err :: EXCEPTION | eff) a
getR tls = plainRequest $ tls <> method := (show GET)

postR :: forall eff a. Generic a => TLSOptions -> URLPath -> Aff (http :: HTTP, err :: EXCEPTION | eff) a
postR tls = plainRequest $ tls <> method := (show POST)

postRBody :: forall eff a b. (Generic a, Generic b) => TLSOptions -> URLPath -> b -> Aff (http :: HTTP, err :: EXCEPTION | eff) a
postRBody tls urlPath = flip bodyRequest urlPath $ tls <> method  := (show POST)

putRBody :: forall eff a b. (Generic a, Generic b) => TLSOptions -> URLPath -> b -> Aff (http :: HTTP, err :: EXCEPTION | eff) a
putRBody tls urlPath = flip bodyRequest urlPath $ tls <> method  := (show PUT)

deleteR :: forall eff a. Generic a => TLSOptions -> URLPath -> Aff (http :: HTTP, err :: EXCEPTION | eff) a
deleteR tls = plainRequest $ tls <> method := (show DELETE)

-- REQUESTS
--------------------------------------------------------------------------------
-- Test ------------------------------------------------------------------------
testReset :: forall eff. TLSOptions -> Aff (http :: HTTP, err :: EXCEPTION | eff) Unit
testReset tls = postR tls $ noQueryParam ["test", "reset"]
--------------------------------------------------------------------------------
-- Wallets ---------------------------------------------------------------------
getWallet :: forall eff. TLSOptions -> CId Wal -> Aff (http :: HTTP, err :: EXCEPTION | eff) CWallet
getWallet tls addr = getR tls $ noQueryParam ["wallets", _address addr]

getWallets :: forall eff. TLSOptions -> Aff (http :: HTTP, err :: EXCEPTION | eff) (Array CWallet)
getWallets tls = getR tls $ noQueryParam ["wallets"]

newWallet :: forall eff. TLSOptions -> Maybe CPassPhrase -> CWalletInit -> Aff (http :: HTTP, err :: EXCEPTION | eff) CWallet
newWallet tls pass = postRBody tls $ queryParams ["wallets", "new"] [qParam "passphrase" $ _passPhrase <$> pass]

updateWallet :: forall eff. TLSOptions -> CId Wal -> CWalletMeta -> Aff (http :: HTTP, err :: EXCEPTION | eff) CWallet
updateWallet tls wId = putRBody tls $ noQueryParam ["wallets", _address wId]

restoreWallet :: forall eff. TLSOptions -> Maybe CPassPhrase -> CWalletInit -> Aff (http :: HTTP, err :: EXCEPTION | eff) CWallet
restoreWallet tls pass = postRBody tls $ queryParams ["wallets", "restore"] [qParam "passphrase" $ _passPhrase <$> pass]

renameWalletSet :: forall eff. TLSOptions -> CId Wal -> String -> Aff (http :: HTTP, err :: EXCEPTION | eff) CWallet
renameWalletSet tls wSetId name = postR tls $ noQueryParam ["wallets", "rename", _address wSetId, name]

importWallet :: forall eff. TLSOptions -> Maybe CPassPhrase -> FilePath -> Aff (http :: HTTP, err :: EXCEPTION | eff) CWallet
importWallet tls pass = postRBody tls $ queryParams ["wallets", "keys"] [qParam "passphrase" $ _passPhrase <$> pass]

changeWalletPass :: forall eff. TLSOptions -> CId Wal -> Maybe CPassPhrase -> Maybe CPassPhrase -> Aff (http :: HTTP, err :: EXCEPTION | eff) Unit
changeWalletPass tls wSetId old new = postR tls $ queryParams ["wallets", "password", _address wSetId] [qParam "old" $ _passPhrase <$> old, qParam "new" $ _passPhrase <$> new]

deleteWallet :: forall eff. TLSOptions -> CId Wal -> Aff (http :: HTTP, err :: EXCEPTION | eff) Unit
deleteWallet tls wSetId = deleteR tls $ noQueryParam ["wallets", _address wSetId]
--------------------------------------------------------------------------------
-- Accounts --------------------------------------------------------------------

getAccount :: forall eff. TLSOptions -> CAccountId -> Aff (http :: HTTP, err :: EXCEPTION | eff) CAccount
getAccount tls wId = getR tls $ noQueryParam ["accounts", walletAddressToUrl wId]

getAccounts :: forall eff. TLSOptions -> Maybe (CId Wal) -> Aff (http :: HTTP, err :: EXCEPTION | eff) (Array CAccount)
getAccounts tls addr = getR tls $ queryParams ["accounts"] [qParam "accountId" $ _address <$> addr]

updateAccount :: forall eff. TLSOptions -> CAccountId -> CAccountMeta -> Aff (http :: HTTP, err :: EXCEPTION | eff) CAccount
updateAccount tls wId = putRBody tls $ noQueryParam ["accounts", walletAddressToUrl wId]

newAccount :: forall eff. TLSOptions -> Maybe CPassPhrase -> CAccountInit -> Aff (http :: HTTP, err :: EXCEPTION | eff) CAccount
newAccount tls pass = postRBody tls $ queryParams ["accounts"] [qParam "passphrase" $ _passPhrase <$> pass]

deleteAccount :: forall eff. TLSOptions -> CAccountId -> Aff (http :: HTTP, err :: EXCEPTION | eff) Unit
deleteAccount tls wId = deleteR tls $ noQueryParam ["accounts", walletAddressToUrl wId]

--------------------------------------------------------------------------------
-- Wallet addresses ------------------------------------------------------------

newAddress :: forall eff. TLSOptions -> Maybe CPassPhrase -> CAccountId -> Aff (http :: HTTP, err :: EXCEPTION | eff) CAddress
newAddress tls pass = postRBody tls $ queryParams ["addresses"] [qParam "passphrase" $ _passPhrase <$> pass]

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

isValidAddress :: forall eff. TLSOptions -> String -> Aff (http :: HTTP, err :: EXCEPTION | eff) Boolean
isValidAddress tls addr = getR tls $ noQueryParam ["addresses", addr]

--------------------------------------------------------------------------------
-- Profiles --------------------------------------------------------------------
getProfile :: forall eff. TLSOptions -> Aff (http :: HTTP, err :: EXCEPTION | eff) CProfile
getProfile tls = getR tls $ noQueryParam ["profile"]

updateProfile :: forall eff. TLSOptions -> CProfile -> Aff (http :: HTTP, err :: EXCEPTION | eff) CProfile
updateProfile tls = postRBody tls $ noQueryParam ["profile"]
--------------------------------------------------------------------------------
-- Transactions ----------------------------------------------------------------
newPayment :: forall eff. TLSOptions -> Maybe CPassPhrase -> CAccountId -> CId Addr -> CCoin -> Aff (http :: HTTP, err :: EXCEPTION | eff) CTx
newPayment tls pass addrFrom addrTo amount = postR tls $ queryParams ["txs", "payments", walletAddressToUrl addrFrom, _address addrTo, _ccoin amount] [qParam "passphrase" $ _passPhrase <$> pass]

txFee :: forall eff. TLSOptions -> CAccountId -> CId Addr -> CCoin -> Aff (http :: HTTP, err :: EXCEPTION | eff) CCoin
txFee tls addrFrom addrTo amount = getR tls $ noQueryParam ["txs", "fee", walletAddressToUrl addrFrom, _address addrTo, _ccoin amount]

updateTransaction :: forall eff. TLSOptions -> CAccountId -> CTxId -> CTxMeta -> Aff (http :: HTTP, err :: EXCEPTION | eff) Unit
updateTransaction tls addr ctxId = postRBody tls $ noQueryParam ["txs", "payments", walletAddressToUrl addr, _ctxIdValue ctxId]

getHistory
  :: forall eff.
     TLSOptions
  -> Maybe (CId Wal)
  -> Maybe CAccountId
  -> Maybe (CId Addr)
  -> Maybe Int
  -> Maybe Int
  -> Aff (http :: HTTP, err :: EXCEPTION | eff) (Tuple (Array CTx) Int)
getHistory tls walletId accountId addr skip limit =
  getR tls $ queryParams
  ["txs", "histories"]
  [ qParam "walletId" $ _address <$> walletId
  , qParam "accountId" $ walletAddressToUrl <$> accountId
  , qParam "address" $ _address <$> addr
  , qParam "skip" $ show <$> skip
  , qParam "limit" $ show <$> limit
  ]

--------------------------------------------------------------------------------
-- Updates ---------------------------------------------------------------------
nextUpdate :: forall eff. TLSOptions -> Aff (http :: HTTP, err :: EXCEPTION | eff) CUpdateInfo
nextUpdate tls = getR tls $ noQueryParam ["update"]

applyUpdate :: forall eff. TLSOptions -> Aff (http :: HTTP, err :: EXCEPTION | eff) Unit
applyUpdate tls = postR tls $ noQueryParam ["update"]

--------------------------------------------------------------------------------
-- Redemptions -----------------------------------------------------------------
redeemAda :: forall eff. TLSOptions -> Maybe CPassPhrase -> CWalletRedeem -> Aff (http :: HTTP, err :: EXCEPTION | eff) CTx
redeemAda tls pass = postRBody tls $ queryParams ["redemptions", "ada"] [qParam "passphrase" $ _passPhrase <$> pass]

redeemAdaPaperVend :: forall eff. TLSOptions -> Maybe CPassPhrase -> CPaperVendWalletRedeem -> Aff (http :: HTTP, err :: EXCEPTION | eff) CTx
redeemAdaPaperVend tls pass = postRBody tls $ queryParams ["papervend", "redemptions", "ada"] [qParam "passphrase" $ _passPhrase <$> pass]

--------------------------------------------------------------------------------
-- REPORTING -------------------------------------------------------------------
reportInit :: forall eff. TLSOptions -> CInitialized -> Aff (http :: HTTP, err :: EXCEPTION | eff) Unit
reportInit tls = postRBody tls $ noQueryParam ["reporting", "initialized"]

--------------------------------------------------------------------------------
-- SETTINGS --------------------------------------------------------------------
blockchainSlotDuration :: forall eff. TLSOptions -> Aff (http :: HTTP, err :: EXCEPTION | eff) Int
blockchainSlotDuration tls = getR tls $ noQueryParam ["settings", "slots", "duration"]

systemVersion :: forall eff. TLSOptions -> Aff (http :: HTTP, err :: EXCEPTION | eff) SoftwareVersion
systemVersion tls = getR tls $ noQueryParam ["settings", "version"]

syncProgress :: forall eff. TLSOptions -> Aff (http :: HTTP, err :: EXCEPTION | eff) SyncProgress
syncProgress tls = getR tls $ noQueryParam ["settings", "sync", "progress"]

--------------------------------------------------------------------------------
-- JSON BACKUP -----------------------------------------------------------------
importBackupJSON :: forall eff. TLSOptions -> String -> Aff (http :: HTTP, err :: EXCEPTION | eff) CWallet
importBackupJSON tls = postRBody tls $ noQueryParam ["backup", "import"]

exportBackupJSON :: forall eff. TLSOptions -> CId Wal -> String -> Aff (http :: HTTP, err :: EXCEPTION | eff) Unit
exportBackupJSON tls addr = postRBody tls $ noQueryParam ["backup", "export", _address addr]

module Daedalus.BackendApi where

import Prelude
import Control.Monad.Eff (Eff)
import Control.Monad.Aff (Aff, makeAff)
import Control.Monad.Eff.Exception (error, Error, throwException)
import Control.Monad.Eff.Exception (EXCEPTION)
import Control.Monad.Error.Class (throwError)
import Control.Monad.Aff (Aff)
import Daedalus.Types (CId, _address, _ccoin, CAccount, CTx, CAccountMeta, CTxId, CTxMeta, _ctxIdValue, WalletError, CProfile, CAccountInit, CUpdateInfo, SoftwareVersion, CWalletRedeem, SyncProgress, CInitialized, CPassPhrase, _passPhrase, CCoin, CPaperVendWalletRedeem, Wal, CWallet, CWalletInit, walletAddressToUrl, CAccountId, CAddress, Addr, CWalletMeta)
import Data.Argonaut (Json)
import Data.Argonaut.Parser (jsonParser)
import Data.Argonaut.Generic.Aeson (decodeJson, encodeJson)
import Data.Bifunctor (bimap, lmap)
import Data.Either (either, Either(Left))
import Data.FormURLEncoded (fromArray, encode)
import Data.Generic (class Generic, gShow)
import Data.HTTP.Method (Method(GET, POST, PUT, DELETE))
import Data.Maybe (Maybe(Just))
import Data.MediaType.Common (applicationJSON)
import Data.Monoid (mempty)
import Data.String (joinWith)
import Data.Tuple (Tuple (..))
import Data.StrMap (fromFoldable)
import Daedalus.TLS (TLSOptions)
import Node.HTTP.Client (method, path, request, statusCode, statusMessage, Response, responseAsStream, headers, RequestHeaders (..), Request, requestAsStream)
import Data.Options ((:=))
import Node.Encoding (Encoding (UTF8))
import Node.Stream (onDataString, writeString, end)
import Node.HTTP (HTTP)

-- HELPERS

type URLPath = Tuple (Array String) QueryParams
type URL = String
type QueryParam = Tuple String (Maybe String)
type QueryParams = Array QueryParam
type FilePath = String

noQueryParam :: Array String -> URLPath
noQueryParam = flip Tuple mempty

queryParams :: Array String -> QueryParams -> URLPath
queryParams = Tuple

qParam :: String -> Maybe String -> QueryParam
qParam = Tuple

mkUrl :: URLPath -> URL
mkUrl (Tuple urlPath params) = joinWith "/" urlPath <> "?" <> encode (fromArray params)

backendApi :: URLPath -> URL
backendApi = mkUrl <<< lmap ((<>) ["/api"])

data ApiError
    = HTTPStatusError Response
    | JSONDecodingError String
    | ServerError WalletError

instance showApiError :: Show ApiError where
    show (HTTPStatusError res) =
        "HTTPStatusError: " <> show (statusCode res) <> " msg: " <> statusMessage res
    show (JSONDecodingError e) =
        "JSONDecodingError: " <> show e
    show (ServerError e) =
        "ServerError: " <> gShow e

-- REQUESTS HELPERS

decodeResult :: forall a eff. Generic a => String -> Either Error a
decodeResult = either (Left <<< mkJSONError) (lmap mkServerError) <<< decodeJson <=< lmap error <<< jsonParser
  where
    mkJSONError = error <<< show <<< JSONDecodingError
    mkServerError = error <<< show <<< ServerError

makeRequest :: forall eff a. (Generic a) => (Request -> Eff (http :: HTTP, err :: EXCEPTION | eff) Unit) -> TLSOptions -> URLPath -> Aff (http :: HTTP, err :: EXCEPTION | eff) a
makeRequest withReq tls urlPath = do
    -- FIXME: exceptin shouldn't happen here?
    res <- makeAff $ const $ withReq <=< request (tls <> path := backendApi urlPath)
    when (isHttpError res) $
        throwError <<< error <<< show $ HTTPStatusError res
    rawData <- makeAff $ const $ onDataString (responseAsStream res) UTF8
    either throwError pure $ decodeResult rawData
  where
    isHttpError res = statusCode res >= 400

plainRequest :: forall eff a r. (Generic a) => TLSOptions -> URLPath -> Aff (http :: HTTP, err :: EXCEPTION | eff) a
plainRequest = makeRequest $ flip end (pure unit) <<< requestAsStream

bodyRequest :: forall eff a b. (Generic a, Generic b) => TLSOptions -> URLPath -> b -> Aff (http :: HTTP, err :: EXCEPTION | eff) a
bodyRequest tls urlPath body = makeRequest flushBody (tls <> headers := reqHeaders) urlPath
  where
    flushBody req = do
        let writeStream = requestAsStream req
        writeString writeStream UTF8 (show $ encodeJson body) $ pure unit
        end writeStream $ pure unit
    -- TODO: use Data.MediaType.Common here
    reqHeaders = RequestHeaders $ fromFoldable [Tuple "Content-Type" "application/json"]

getR :: forall eff a. Generic a => TLSOptions -> URLPath -> Aff (http :: HTTP, err :: EXCEPTION | eff) a
getR tls = plainRequest $ tls <> method := (show GET)

postR :: forall eff a. Generic a => TLSOptions -> URLPath -> Aff (http :: HTTP, err :: EXCEPTION | eff) a
postR tls = plainRequest $ tls <> method := (show POST)

postRBody :: forall eff a b. (Generic a, Generic b) => TLSOptions -> URLPath -> b -> Aff (http :: HTTP, err :: EXCEPTION | eff) a
postRBody tls urlPath = flip bodyRequest urlPath $ tls <> method  := (show POST)

putRBody :: forall eff a b. (Generic a, Generic b) => TLSOptions -> URLPath -> b -> Aff (http :: HTTP, err :: EXCEPTION | eff) a
putRBody tls urlPath = flip bodyRequest urlPath $ tls <> method  := (show PUT)

deleteR :: forall eff a. Generic a => TLSOptions -> URLPath -> Aff (http :: HTTP, err :: EXCEPTION | eff) a
deleteR tls = plainRequest $ tls <> method := (show DELETE)

-- REQUESTS
--------------------------------------------------------------------------------
-- Test ------------------------------------------------------------------------
testReset :: forall eff. TLSOptions -> Aff (http :: HTTP, err :: EXCEPTION | eff) Unit
testReset tls = postR tls $ noQueryParam ["test", "reset"]
--------------------------------------------------------------------------------
-- Wallets ---------------------------------------------------------------------
getWallet :: forall eff. TLSOptions -> CId Wal -> Aff (http :: HTTP, err :: EXCEPTION | eff) CWallet
getWallet tls addr = getR tls $ noQueryParam ["wallets", _address addr]

getWallets :: forall eff. TLSOptions -> Aff (http :: HTTP, err :: EXCEPTION | eff) (Array CWallet)
getWallets tls = getR tls $ noQueryParam ["wallets"]

newWallet :: forall eff. TLSOptions -> Maybe CPassPhrase -> CWalletInit -> Aff (http :: HTTP, err :: EXCEPTION | eff) CWallet
newWallet tls pass = postRBody tls $ queryParams ["wallets", "new"] [qParam "passphrase" $ _passPhrase <$> pass]

updateWallet :: forall eff. TLSOptions -> CId Wal -> CWalletMeta -> Aff (http :: HTTP, err :: EXCEPTION | eff) CWallet
updateWallet tls wId = putRBody tls $ noQueryParam ["wallets", _address wId]

restoreWallet :: forall eff. TLSOptions -> Maybe CPassPhrase -> CWalletInit -> Aff (http :: HTTP, err :: EXCEPTION | eff) CWallet
restoreWallet tls pass = postRBody tls $ queryParams ["wallets", "restore"] [qParam "passphrase" $ _passPhrase <$> pass]

renameWalletSet :: forall eff. TLSOptions -> CId Wal -> String -> Aff (http :: HTTP, err :: EXCEPTION | eff) CWallet
renameWalletSet tls wSetId name = postR tls $ noQueryParam ["wallets", "rename", _address wSetId, name]

importWallet :: forall eff. TLSOptions -> Maybe CPassPhrase -> FilePath -> Aff (http :: HTTP, err :: EXCEPTION | eff) CWallet
importWallet tls pass = postRBody tls $ queryParams ["wallets", "keys"] [qParam "passphrase" $ _passPhrase <$> pass]

changeWalletPass :: forall eff. TLSOptions -> CId Wal -> Maybe CPassPhrase -> Maybe CPassPhrase -> Aff (http :: HTTP, err :: EXCEPTION | eff) Unit
changeWalletPass tls wSetId old new = postR tls $ queryParams ["wallets", "password", _address wSetId] [qParam "old" $ _passPhrase <$> old, qParam "new" $ _passPhrase <$> new]

deleteWallet :: forall eff. TLSOptions -> CId Wal -> Aff (http :: HTTP, err :: EXCEPTION | eff) Unit
deleteWallet tls wSetId = deleteR tls $ noQueryParam ["wallets", _address wSetId]
--------------------------------------------------------------------------------
-- Accounts --------------------------------------------------------------------

getAccount :: forall eff. TLSOptions -> CAccountId -> Aff (http :: HTTP, err :: EXCEPTION | eff) CAccount
getAccount tls wId = getR tls $ noQueryParam ["accounts", walletAddressToUrl wId]

getAccounts :: forall eff. TLSOptions -> Maybe (CId Wal) -> Aff (http :: HTTP, err :: EXCEPTION | eff) (Array CAccount)
getAccounts tls addr = getR tls $ queryParams ["accounts"] [qParam "accountId" $ _address <$> addr]

updateAccount :: forall eff. TLSOptions -> CAccountId -> CAccountMeta -> Aff (http :: HTTP, err :: EXCEPTION | eff) CAccount
updateAccount tls wId = putRBody tls $ noQueryParam ["accounts", walletAddressToUrl wId]

newAccount :: forall eff. TLSOptions -> Maybe CPassPhrase -> CAccountInit -> Aff (http :: HTTP, err :: EXCEPTION | eff) CAccount
newAccount tls pass = postRBody tls $ queryParams ["accounts"] [qParam "passphrase" $ _passPhrase <$> pass]

deleteAccount :: forall eff. TLSOptions -> CAccountId -> Aff (http :: HTTP, err :: EXCEPTION | eff) Unit
deleteAccount tls wId = deleteR tls $ noQueryParam ["accounts", walletAddressToUrl wId]

--------------------------------------------------------------------------------
-- Wallet addresses ------------------------------------------------------------

newAddress :: forall eff. TLSOptions -> Maybe CPassPhrase -> CAccountId -> Aff (http :: HTTP, err :: EXCEPTION | eff) CAddress
newAddress tls pass = postRBody tls $ queryParams ["addresses"] [qParam "passphrase" $ _passPhrase <$> pass]

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

isValidAddress :: forall eff. TLSOptions -> String -> Aff (http :: HTTP, err :: EXCEPTION | eff) Boolean
isValidAddress tls addr = getR tls $ noQueryParam ["addresses", addr]

--------------------------------------------------------------------------------
-- Profiles --------------------------------------------------------------------
getProfile :: forall eff. TLSOptions -> Aff (http :: HTTP, err :: EXCEPTION | eff) CProfile
getProfile tls = getR tls $ noQueryParam ["profile"]

updateProfile :: forall eff. TLSOptions -> CProfile -> Aff (http :: HTTP, err :: EXCEPTION | eff) CProfile
updateProfile tls = postRBody tls $ noQueryParam ["profile"]
--------------------------------------------------------------------------------
-- Transactions ----------------------------------------------------------------
newPayment :: forall eff. TLSOptions -> Maybe CPassPhrase -> CAccountId -> CId Addr -> CCoin -> Aff (http :: HTTP, err :: EXCEPTION | eff) CTx
newPayment tls pass addrFrom addrTo amount = postR tls $ queryParams ["txs", "payments", walletAddressToUrl addrFrom, _address addrTo, _ccoin amount] [qParam "passphrase" $ _passPhrase <$> pass]

txFee :: forall eff. TLSOptions -> CAccountId -> CId Addr -> CCoin -> Aff (http :: HTTP, err :: EXCEPTION | eff) CCoin
txFee tls addrFrom addrTo amount = getR tls $ noQueryParam ["txs", "fee", walletAddressToUrl addrFrom, _address addrTo, _ccoin amount]

updateTransaction :: forall eff. TLSOptions -> CAccountId -> CTxId -> CTxMeta -> Aff (http :: HTTP, err :: EXCEPTION | eff) Unit
updateTransaction tls addr ctxId = postRBody tls $ noQueryParam ["txs", "payments", walletAddressToUrl addr, _ctxIdValue ctxId]

getHistory
  :: forall eff.
     TLSOptions
  -> Maybe (CId Wal)
  -> Maybe CAccountId
  -> Maybe (CId Addr)
  -> Maybe Int
  -> Maybe Int
  -> Aff (http :: HTTP, err :: EXCEPTION | eff) (Tuple (Array CTx) Int)
getHistory tls walletId accountId addr skip limit =
  getR tls $ queryParams
  ["txs", "histories"]
  [ qParam "walletId" $ _address <$> walletId
  , qParam "accountId" $ walletAddressToUrl <$> accountId
  , qParam "address" $ _address <$> addr
  , qParam "skip" $ show <$> skip
  , qParam "limit" $ show <$> limit
  ]

--------------------------------------------------------------------------------
-- Updates ---------------------------------------------------------------------
nextUpdate :: forall eff. TLSOptions -> Aff (http :: HTTP, err :: EXCEPTION | eff) CUpdateInfo
nextUpdate tls = getR tls $ noQueryParam ["update"]

applyUpdate :: forall eff. TLSOptions -> Aff (http :: HTTP, err :: EXCEPTION | eff) Unit
applyUpdate tls = postR tls $ noQueryParam ["update"]

--------------------------------------------------------------------------------
-- Redemptions -----------------------------------------------------------------
redeemAda :: forall eff. TLSOptions -> Maybe CPassPhrase -> CWalletRedeem -> Aff (http :: HTTP, err :: EXCEPTION | eff) CTx
redeemAda tls pass = postRBody tls $ queryParams ["redemptions", "ada"] [qParam "passphrase" $ _passPhrase <$> pass]

redeemAdaPaperVend :: forall eff. TLSOptions -> Maybe CPassPhrase -> CPaperVendWalletRedeem -> Aff (http :: HTTP, err :: EXCEPTION | eff) CTx
redeemAdaPaperVend tls pass = postRBody tls $ queryParams ["papervend", "redemptions", "ada"] [qParam "passphrase" $ _passPhrase <$> pass]

--------------------------------------------------------------------------------
-- REPORTING -------------------------------------------------------------------
reportInit :: forall eff. TLSOptions -> CInitialized -> Aff (http :: HTTP, err :: EXCEPTION | eff) Unit
reportInit tls = postRBody tls $ noQueryParam ["reporting", "initialized"]

--------------------------------------------------------------------------------
-- SETTINGS --------------------------------------------------------------------
blockchainSlotDuration :: forall eff. TLSOptions -> Aff (http :: HTTP, err :: EXCEPTION | eff) Int
blockchainSlotDuration tls = getR tls $ noQueryParam ["settings", "slots", "duration"]

systemVersion :: forall eff. TLSOptions -> Aff (http :: HTTP, err :: EXCEPTION | eff) SoftwareVersion
systemVersion tls = getR tls $ noQueryParam ["settings", "version"]

syncProgress :: forall eff. TLSOptions -> Aff (http :: HTTP, err :: EXCEPTION | eff) SyncProgress
syncProgress tls = getR tls $ noQueryParam ["settings", "sync", "progress"]

--------------------------------------------------------------------------------
-- JSON BACKUP -----------------------------------------------------------------
importBackupJSON :: forall eff. TLSOptions -> String -> Aff (http :: HTTP, err :: EXCEPTION | eff) (Array CWallet)
importBackupJSON tls = postRBody tls $ noQueryParam ["backup", "import"]

exportBackupJSON :: forall eff. TLSOptions -> CId Wal -> String -> Aff (http :: HTTP, err :: EXCEPTION | eff) Unit
exportBackupJSON tls addr = postRBody tls $ noQueryParam ["backup", "export", _address addr]


Removing unused import

Removing unused import

module Data.Coyoneda
  ( Coyoneda(..)
  , Natural(..)
  , coyoneda
  , liftCoyoneda
  , lowerCoyoneda
  , liftCoyonedaT
  , liftCoyonedaTF
  ) where

import Control.Comonad
import Control.Extend
import Control.Monad.Trans

newtype Coyoneda f a = Coyoneda (forall i. { k :: i -> a , fi :: f i })

type Natural f g = forall a. f a -> g a

instance functorCoyoneda :: Functor (Coyoneda f) where
  (<$>) f (Coyoneda v) = Coyoneda v { k = f <<< v.k }

instance applyCoyoneda :: (Apply f) => Apply (Coyoneda f) where
  (<*>) f g = liftCoyoneda $ lowerCoyoneda f <*> lowerCoyoneda g

instance applicativeCoyoneda :: (Applicative f) => Applicative (Coyoneda f) where
  pure = liftCoyoneda <<< pure

instance bindCoyoneda :: (Bind f) => Bind (Coyoneda f) where
  (>>=) (Coyoneda v) k = liftCoyoneda $ v.fi >>= lowerCoyoneda <<< k <<< v.k

instance monadCoyoneda :: (Monad f) => Monad (Coyoneda f)

instance monadTransCoyoneda :: MonadTrans Coyoneda where
  lift = liftCoyoneda

instance extendCoyoneda :: (Extend w) => Extend (Coyoneda w) where
  (<<=) f (Coyoneda w) = liftCoyoneda $ f <<< coyoneda w.k <<= w.fi

instance comonadCoyoneda :: (Comonad w) => Comonad (Coyoneda w) where
  extract (Coyoneda w) = w.k $ extract w.fi

coyoneda :: forall f a b. (a -> b) -> f a -> Coyoneda f b
coyoneda k fi = k <$> liftCoyoneda fi

--liftCoyoneda :: forall f a. f a -> Coyoneda f a
--liftCoyoneda fa = Coyoneda { k: id , fi: fa }
foreign import liftCoyoneda "function liftCoyoneda(fa){return {k: function(a){return a;}, fi: fa};}"
  :: forall f a. f a -> Coyoneda f a

lowerCoyoneda :: forall f a. (Functor f) => Coyoneda f a -> f a
lowerCoyoneda (Coyoneda v) = v.k <$> v.fi

liftCoyonedaT :: forall f g. Natural f g -> Natural (Coyoneda f) (Coyoneda g)
liftCoyonedaT nat = \(Coyoneda v) -> Coyoneda v { fi = nat v.fi }

liftCoyonedaTF :: forall f g. (Functor g) => Natural f g -> Natural (Coyoneda f) g
liftCoyonedaTF nat = lowerCoyoneda <<< liftCoyonedaT nat

module Data.Coyoneda
  ( Coyoneda(..)
  , Natural(..)
  , coyoneda
  , liftCoyoneda
  , lowerCoyoneda
  , liftCoyonedaT
  , liftCoyonedaTF
  ) where

import Control.Comonad
import Control.Extend
import Control.Monad.Trans
import Data.Tuple

newtype Coyoneda f a = Coyoneda (forall i. { k :: i -> a , fi :: f i })

type Natural f g = forall a. f a -> g a

instance functorCoyoneda :: Functor (Coyoneda f) where
  (<$>) f (Coyoneda v) = Coyoneda v { k = f <<< v.k }

instance applyCoyoneda :: (Apply f) => Apply (Coyoneda f) where
  (<*>) f g = liftCoyoneda $ lowerCoyoneda f <*> lowerCoyoneda g

instance applicativeCoyoneda :: (Applicative f) => Applicative (Coyoneda f) where
  pure = liftCoyoneda <<< pure

instance bindCoyoneda :: (Bind f) => Bind (Coyoneda f) where
  (>>=) (Coyoneda v) k = liftCoyoneda $ v.fi >>= lowerCoyoneda <<< k <<< v.k

instance monadCoyoneda :: (Monad f) => Monad (Coyoneda f)

instance monadTransCoyoneda :: MonadTrans Coyoneda where
  lift = liftCoyoneda

instance extendCoyoneda :: (Extend w) => Extend (Coyoneda w) where
  (<<=) f (Coyoneda w) = liftCoyoneda $ f <<< coyoneda w.k <<= w.fi

instance comonadCoyoneda :: (Comonad w) => Comonad (Coyoneda w) where
  extract (Coyoneda w) = w.k $ extract w.fi

coyoneda :: forall f a b. (a -> b) -> f a -> Coyoneda f b
coyoneda k fi = k <$> liftCoyoneda fi

--liftCoyoneda :: forall f a. f a -> Coyoneda f a
--liftCoyoneda fa = Coyoneda { k: id , fi: fa }
foreign import liftCoyoneda "function liftCoyoneda(fa){return {k: function(a){return a;}, fi: fa};}"
  :: forall f a. f a -> Coyoneda f a

lowerCoyoneda :: forall f a. (Functor f) => Coyoneda f a -> f a
lowerCoyoneda (Coyoneda v) = v.k <$> v.fi

liftCoyonedaT :: forall f g. Natural f g -> Natural (Coyoneda f) (Coyoneda g)
liftCoyonedaT nat = \(Coyoneda v) -> Coyoneda v { fi = nat v.fi }

liftCoyonedaTF :: forall f g. (Functor g) => Natural f g -> Natural (Coyoneda f) g
liftCoyonedaTF nat = lowerCoyoneda <<< liftCoyonedaT nat


Fix Async actions from evaluating too early

module Node.FS.Async
  ( Callback (..)
  , rename
  , truncate
  , chown
  , chmod
  , stat
  , link
  , symlink
  , readlink
  , realpath
  , realpath'
  , unlink
  , rmdir
  , mkdir
  , mkdir'
  , readdir
  , utimes
  , readFile
  , readTextFile
  , writeFile
  , writeTextFile
  , appendFile
  , appendTextFile
  ) where

import Control.Monad.Eff
import Control.Monad.Eff.Exception
import Data.Date
import Data.Either
import Data.Function
import Data.Maybe
import Node.Buffer (Buffer(..))
import Node.Encoding
import Node.FS
import Node.FS.Stats
import Node.Path (FilePath())

foreign import data Nullable :: * -> *

type JSCallback a = Fn2 (Nullable Error) a Unit

foreign import handleCallbackImpl
  "function handleCallbackImpl(left, right, f) {\
  \  return function(err, value) {\
  \    if (err) f(left(err))();\
  \    else f(right(value))();\
  \  };\
  \}" :: forall eff a. Fn3 (Error -> Either Error a)
                           (a -> Either Error a)
                           (Callback eff a)
                           (JSCallback a)

handleCallback :: forall eff a b. (Callback eff a) -> JSCallback a
handleCallback cb = runFn3 handleCallbackImpl Left Right cb

foreign import fs "var fs = require('fs');" ::
  { rename :: Fn3 FilePath FilePath (JSCallback Unit) Unit
  , truncate :: Fn3 FilePath Number (JSCallback Unit) Unit
  , chown :: Fn4 FilePath Number Number (JSCallback Unit) Unit
  , chmod :: Fn3 FilePath Number (JSCallback Unit) Unit
  , stat :: Fn2 FilePath (JSCallback StatsObj) Unit
  , link :: Fn3 FilePath FilePath (JSCallback Unit) Unit
  , symlink :: Fn4 FilePath FilePath String (JSCallback Unit) Unit
  , readlink :: Fn2 FilePath (JSCallback FilePath) Unit
  , realpath :: forall cache. Fn3 FilePath { | cache } (JSCallback FilePath) Unit
  , unlink :: Fn2 FilePath (JSCallback Unit) Unit
  , rmdir :: Fn2 FilePath (JSCallback Unit) Unit
  , mkdir :: Fn3 FilePath Number (JSCallback Unit) Unit
  , readdir :: Fn2 FilePath (JSCallback [FilePath]) Unit
  , utimes :: Fn4 FilePath Number Number (JSCallback Unit) Unit
  , readFile :: forall a opts. Fn3 FilePath { | opts } (JSCallback a) Unit
  , writeFile :: forall a opts. Fn4 FilePath a { | opts } (JSCallback Unit) Unit
  , appendFile :: forall a opts. Fn4 FilePath a { | opts } (JSCallback Unit) Unit
  , exists :: forall a. Fn2 FilePath (Boolean -> a) Unit
  }

foreign import mkEff
  "function mkEff(action) {\
  \  return action;\
  \}" :: forall eff a. (Unit -> a) -> Eff eff a

-- |
-- Type synonym for callback functions.
--
type Callback eff a = Either Error a -> Eff eff Unit

-- |
-- Renames a file.
--
rename :: forall eff. FilePath
                   -> FilePath
                   -> Callback eff Unit
                   -> Eff (fs :: FS | eff) Unit

rename oldFile newFile cb = mkEff $ \_ -> runFn3
  fs.rename oldFile newFile (handleCallback cb)

-- |
-- Truncates a file to the specified length.
--
truncate :: forall eff. FilePath
                     -> Number
                     -> Callback eff Unit
                     -> Eff (fs :: FS | eff) Unit

truncate file len cb = mkEff $ \_ -> runFn3
  fs.truncate file len (handleCallback cb)

-- |
-- Changes the ownership of a file.
--
chown :: forall eff. FilePath
                  -> Number
                  -> Number
                  -> Callback eff Unit
                  -> Eff (fs :: FS | eff) Unit

chown file uid gid cb = mkEff $ \_ -> runFn4
  fs.chown file uid gid (handleCallback cb)

-- |
-- Changes the permissions of a file.
--
chmod :: forall eff. FilePath
                  -> Number
                  -> Callback eff Unit
                  -> Eff (fs :: FS | eff) Unit

chmod file mode cb = mkEff $ \_ -> runFn3
  fs.chmod file mode (handleCallback cb)

-- |
-- Gets file statistics.
--
stat :: forall eff. FilePath
                 -> Callback eff Stats
                 -> Eff (fs :: FS | eff) Unit

stat file cb = mkEff $ \_ -> runFn2
  fs.stat file (handleCallback $ cb <<< (<$>) Stats)

-- |
-- Creates a link to an existing file.
--
link :: forall eff. FilePath
                 -> FilePath
                 -> Callback eff Unit
                 -> Eff (fs :: FS | eff) Unit

link src dst cb = mkEff $ \_ -> runFn3
  fs.link src dst (handleCallback cb)

-- |
-- Creates a symlink.
--
symlink :: forall eff. FilePath
                    -> FilePath
                    -> SymlinkType
                    -> Callback eff Unit
                    -> Eff (fs :: FS | eff) Unit

symlink src dest ty cb = mkEff $ \_ -> runFn4
  fs.symlink src dest (show ty) (handleCallback cb)

-- |
-- Reads the value of a symlink.
--
readlink :: forall eff. FilePath
                     -> Callback eff FilePath
                     -> Eff (fs :: FS | eff) Unit

readlink path cb = mkEff $ \_ -> runFn2
  fs.readlink path (handleCallback cb)

-- |
-- Find the canonicalized absolute location for a path.
--
realpath :: forall eff. FilePath
                     -> Callback eff FilePath
                     -> Eff (fs :: FS | eff) Unit

realpath path cb = mkEff $ \_ -> runFn3
  fs.realpath path {} (handleCallback cb)

-- |
-- Find the canonicalized absolute location for a path using a cache object for
-- already resolved paths.
--
realpath' :: forall eff cache. FilePath
                            -> { | cache }
                            -> Callback eff FilePath
                            -> Eff (fs :: FS | eff) Unit

realpath' path cache cb = mkEff $ \_ -> runFn3
  fs.realpath path cache (handleCallback cb)

-- |
-- Deletes a file.
--
unlink :: forall eff. FilePath
                   -> Callback eff Unit
                   -> Eff (fs :: FS | eff) Unit

unlink file cb = mkEff $ \_ -> runFn2
  fs.unlink file (handleCallback cb)

-- |
-- Deletes a directory.
--
rmdir :: forall eff. FilePath
                   -> Callback eff Unit
                   -> Eff (fs :: FS | eff) Unit

rmdir file cb = mkEff $ \_ -> runFn2
  fs.rmdir file (handleCallback cb)

-- |
-- Makes a new directory.
--
mkdir :: forall eff. FilePath
                  -> Callback eff Unit
                  -> Eff (fs :: FS | eff) Unit

mkdir = flip mkdir' 777

-- |
-- Makes a new directory with the specified permissions.
--
mkdir' :: forall eff. FilePath
                   -> Number
                   -> Callback eff Unit
                   -> Eff (fs :: FS | eff) Unit

mkdir' file mode cb = mkEff $ \_ -> runFn3
  fs.mkdir file mode (handleCallback cb)

-- |
-- Reads the contents of a directory.
--
readdir :: forall eff. FilePath
                    -> Callback eff [FilePath]
                    -> Eff (fs :: FS | eff) Unit

readdir file cb = mkEff $ \_ -> runFn2
  fs.readdir file (handleCallback cb)

-- |
-- Sets the accessed and modified times for the specified file.
--
utimes :: forall eff. FilePath
                   -> Date
                   -> Date
                   -> Callback eff Unit
                   -> Eff (fs :: FS | eff) Unit

utimes file atime mtime cb = mkEff $ \_ -> runFn4
  fs.utimes file
            ((toEpochMilliseconds atime) / 1000)
            ((toEpochMilliseconds mtime) / 1000)
            (handleCallback cb)

-- |
-- Reads the entire contents of a file returning the result as a raw buffer.
--
readFile :: forall eff. FilePath
                     -> Callback eff Buffer
                     -> Eff (fs :: FS | eff) Unit

readFile file cb = mkEff $ \_ -> runFn3
  fs.readFile file {} (handleCallback cb)

-- |
-- Reads the entire contents of a text file with the specified encoding.
--
readTextFile :: forall eff. Encoding
                         -> FilePath
                         -> Callback eff String
                         -> Eff (fs :: FS | eff) Unit

readTextFile encoding file cb = mkEff $ \_ -> runFn3
  fs.readFile file { encoding: show encoding } (handleCallback cb)

-- |
-- Writes a buffer to a file.
--
writeFile :: forall eff. FilePath
                      -> Buffer
                      -> Callback eff Unit
                      -> Eff (fs :: FS | eff) Unit

writeFile file buff cb = mkEff $ \_ -> runFn4
  fs.writeFile file buff {} (handleCallback cb)

-- |
-- Writes text to a file using the specified encoding.
--
writeTextFile :: forall eff. Encoding
                          -> FilePath
                          -> String
                          -> Callback eff Unit
                          -> Eff (fs :: FS | eff) Unit

writeTextFile encoding file buff cb = mkEff $ \_ -> runFn4
  fs.writeFile file buff { encoding: show encoding } (handleCallback cb)

-- |
-- Appends the contents of a buffer to a file.
--
appendFile :: forall eff. FilePath
                       -> Buffer
                       -> Callback eff Unit
                       -> Eff (fs :: FS | eff) Unit

appendFile file buff cb = mkEff $ \_ -> runFn4
  fs.appendFile file buff {} (handleCallback cb)

-- |
-- Appends text to a file using the specified encoding.
--
appendTextFile :: forall eff. Encoding
                           -> FilePath
                           -> String
                           -> Callback eff Unit
                           -> Eff (fs :: FS | eff) Unit

appendTextFile encoding file buff cb = mkEff $ \_ -> runFn4
  fs.appendFile file buff { encoding: show encoding } (handleCallback cb)

module Node.FS.Async
  ( Callback (..)
  , rename
  , truncate
  , chown
  , chmod
  , stat
  , link
  , symlink
  , readlink
  , realpath
  , realpath'
  , unlink
  , rmdir
  , mkdir
  , mkdir'
  , readdir
  , utimes
  , readFile
  , readTextFile
  , writeFile
  , writeTextFile
  , appendFile
  , appendTextFile
  ) where

import Control.Monad.Eff
import Control.Monad.Eff.Exception
import Data.Date
import Data.Either
import Data.Function
import Data.Maybe
import Node.Buffer (Buffer(..))
import Node.Encoding
import Node.FS
import Node.FS.Stats
import Node.Path (FilePath())

foreign import data Nullable :: * -> *

type JSCallback a = Fn2 (Nullable Error) a Unit

foreign import handleCallbackImpl
  "function handleCallbackImpl(left, right, f) {\
  \  return function(err, value) {\
  \    if (err) f(left(err))();\
  \    else f(right(value))();\
  \  };\
  \}" :: forall eff a. Fn3 (Error -> Either Error a)
                           (a -> Either Error a)
                           (Callback eff a)
                           (JSCallback a)

handleCallback :: forall eff a b. (Callback eff a) -> JSCallback a
handleCallback cb = runFn3 handleCallbackImpl Left Right cb

foreign import fs "var fs = require('fs');" ::
  { rename :: Fn3 FilePath FilePath (JSCallback Unit) Unit
  , truncate :: Fn3 FilePath Number (JSCallback Unit) Unit
  , chown :: Fn4 FilePath Number Number (JSCallback Unit) Unit
  , chmod :: Fn3 FilePath Number (JSCallback Unit) Unit
  , stat :: Fn2 FilePath (JSCallback StatsObj) Unit
  , link :: Fn3 FilePath FilePath (JSCallback Unit) Unit
  , symlink :: Fn4 FilePath FilePath String (JSCallback Unit) Unit
  , readlink :: Fn2 FilePath (JSCallback FilePath) Unit
  , realpath :: forall cache. Fn3 FilePath { | cache } (JSCallback FilePath) Unit
  , unlink :: Fn2 FilePath (JSCallback Unit) Unit
  , rmdir :: Fn2 FilePath (JSCallback Unit) Unit
  , mkdir :: Fn3 FilePath Number (JSCallback Unit) Unit
  , readdir :: Fn2 FilePath (JSCallback [FilePath]) Unit
  , utimes :: Fn4 FilePath Number Number (JSCallback Unit) Unit
  , readFile :: forall a opts. Fn3 FilePath { | opts } (JSCallback a) Unit
  , writeFile :: forall a opts. Fn4 FilePath a { | opts } (JSCallback Unit) Unit
  , appendFile :: forall a opts. Fn4 FilePath a { | opts } (JSCallback Unit) Unit
  }

-- |
-- Type synonym for callback functions.
--
type Callback eff a = Either Error a -> Eff eff Unit

-- |
-- Renames a file.
--
rename :: forall eff. FilePath
                   -> FilePath
                   -> Callback eff Unit
                   -> Eff (fs :: FS | eff) Unit

rename oldFile newFile cb = return $ runFn3
  fs.rename oldFile newFile (handleCallback cb)

-- |
-- Truncates a file to the specified length.
--
truncate :: forall eff. FilePath
                     -> Number
                     -> Callback eff Unit
                     -> Eff (fs :: FS | eff) Unit

truncate file len cb = return $ runFn3
  fs.truncate file len (handleCallback cb)

-- |
-- Changes the ownership of a file.
--
chown :: forall eff. FilePath
                  -> Number
                  -> Number
                  -> Callback eff Unit
                  -> Eff (fs :: FS | eff) Unit

chown file uid gid cb = return $ runFn4
  fs.chown file uid gid (handleCallback cb)

-- |
-- Changes the permissions of a file.
--
chmod :: forall eff. FilePath
                  -> Number
                  -> Callback eff Unit
                  -> Eff (fs :: FS | eff) Unit

chmod file mode cb = return $ runFn3
  fs.chmod file mode (handleCallback cb)

-- |
-- Gets file statistics.
--
stat :: forall eff. FilePath
                 -> Callback eff Stats
                 -> Eff (fs :: FS | eff) Unit

stat file cb = return $ runFn2
  fs.stat file (handleCallback $ cb <<< (<$>) Stats)

-- |
-- Creates a link to an existing file.
--
link :: forall eff. FilePath
                 -> FilePath
                 -> Callback eff Unit
                 -> Eff (fs :: FS | eff) Unit

link src dst cb = return $ runFn3
  fs.link src dst (handleCallback cb)

-- |
-- Creates a symlink.
--
symlink :: forall eff. FilePath
                    -> FilePath
                    -> SymlinkType
                    -> Callback eff Unit
                    -> Eff (fs :: FS | eff) Unit

symlink src dest ty cb = return $ runFn4
  fs.symlink src dest (show ty) (handleCallback cb)

-- |
-- Reads the value of a symlink.
--
readlink :: forall eff. FilePath
                     -> Callback eff FilePath
                     -> Eff (fs :: FS | eff) Unit

readlink path cb = return $ runFn2
  fs.readlink path (handleCallback cb)

-- |
-- Find the canonicalized absolute location for a path.
--
realpath :: forall eff. FilePath
                     -> Callback eff FilePath
                     -> Eff (fs :: FS | eff) Unit

realpath path cb = return $ runFn3
  fs.realpath path {} (handleCallback cb)

-- |
-- Find the canonicalized absolute location for a path using a cache object for
-- already resolved paths.
--
realpath' :: forall eff cache. FilePath
                            -> { | cache }
                            -> Callback eff FilePath
                            -> Eff (fs :: FS | eff) Unit

realpath' path cache cb = return $ runFn3
  fs.realpath path cache (handleCallback cb)

-- |
-- Deletes a file.
--
unlink :: forall eff. FilePath
                   -> Callback eff Unit
                   -> Eff (fs :: FS | eff) Unit

unlink file cb = return $ runFn2
  fs.unlink file (handleCallback cb)

-- |
-- Deletes a directory.
--
rmdir :: forall eff. FilePath
                   -> Callback eff Unit
                   -> Eff (fs :: FS | eff) Unit

rmdir file cb = return $ runFn2
  fs.rmdir file (handleCallback cb)

-- |
-- Makes a new directory.
--
mkdir :: forall eff. FilePath
                  -> Callback eff Unit
                  -> Eff (fs :: FS | eff) Unit

mkdir = flip mkdir' 777

-- |
-- Makes a new directory with the specified permissions.
--
mkdir' :: forall eff. FilePath
                   -> Number
                   -> Callback eff Unit
                   -> Eff (fs :: FS | eff) Unit

mkdir' file mode cb = return $ runFn3
  fs.mkdir file mode (handleCallback cb)

-- |
-- Reads the contents of a directory.
--
readdir :: forall eff. FilePath
                    -> Callback eff [FilePath]
                    -> Eff (fs :: FS | eff) Unit

readdir file cb = return $ runFn2
  fs.readdir file (handleCallback cb)

-- |
-- Sets the accessed and modified times for the specified file.
--
utimes :: forall eff. FilePath
                   -> Date
                   -> Date
                   -> Callback eff Unit
                   -> Eff (fs :: FS | eff) Unit

utimes file atime mtime cb = return $ runFn4
  fs.utimes file
            ((toEpochMilliseconds atime) / 1000)
            ((toEpochMilliseconds mtime) / 1000)
            (handleCallback cb)

-- |
-- Reads the entire contents of a file returning the result as a raw buffer.
--
readFile :: forall eff. FilePath
                     -> Callback eff Buffer
                     -> Eff (fs :: FS | eff) Unit

readFile file cb = return $ runFn3
  fs.readFile file {} (handleCallback cb)

-- |
-- Reads the entire contents of a text file with the specified encoding.
--
readTextFile :: forall eff. Encoding
                         -> FilePath
                         -> Callback eff String
                         -> Eff (fs :: FS | eff) Unit

readTextFile encoding file cb = return $ runFn3
  fs.readFile file { encoding: show encoding } (handleCallback cb)

-- |
-- Writes a buffer to a file.
--
writeFile :: forall eff. FilePath
                      -> Buffer
                      -> Callback eff Unit
                      -> Eff (fs :: FS | eff) Unit

writeFile file buff cb = return $ runFn4
  fs.writeFile file buff {} (handleCallback cb)

-- |
-- Writes text to a file using the specified encoding.
--
writeTextFile :: forall eff. Encoding
                          -> FilePath
                          -> String
                          -> Callback eff Unit
                          -> Eff (fs :: FS | eff) Unit

writeTextFile encoding file buff cb = return $ runFn4
  fs.writeFile file buff { encoding: show encoding } (handleCallback cb)

-- |
-- Appends the contents of a buffer to a file.
--
appendFile :: forall eff. FilePath
                       -> Buffer
                       -> Callback eff Unit
                       -> Eff (fs :: FS | eff) Unit

appendFile file buff cb = return $ runFn4
  fs.appendFile file buff {} (handleCallback cb)

-- |
-- Appends text to a file using the specified encoding.
--
appendTextFile :: forall eff. Encoding
                           -> FilePath
                           -> String
                           -> Callback eff Unit
                           -> Eff (fs :: FS | eff) Unit

appendTextFile encoding file buff cb = return $ runFn4
  fs.appendFile file buff { encoding: show encoding } (handleCallback cb)


bug fix for unsafeCodePointAt0Fallback

bug fix for unsafeCodePointAt0Fallback

-- | These functions allow PureScript strings to be treated as if they were
-- | sequences of Unicode code points instead of their true underlying
-- | implementation (sequences of UTF-16 code units). For nearly all uses of
-- | strings, these functions should be preferred over the ones in Data.String.
module Data.String.CodePoints
  ( module StringReExports
  , CodePoint()
  , codePointAt
  , codePointFromInt
  , codePointToInt
  , count
  , drop
  , dropWhile
  , fromCodePointArray
  , indexOf
  , indexOf'
  , lastIndexOf
  , lastIndexOf'
  , length
  , singleton
  , splitAt
  , take
  , takeWhile
  , toCodePointArray
  , uncons
  ) where

import Prelude

import Data.Array as Array
import Data.Char as Char
import Data.List (List(Cons, Nil), fromFoldable)
import Data.Maybe (Maybe(Just, Nothing))
import Data.String as String
import Data.String.Unsafe as Unsafe
-- WARN: This list must be updated to re-export any exports added to Data.String. That makes me sad.
import Data.String (Pattern(..), Replacement(..), charAt, charCodeAt, contains, fromCharArray, joinWith, localeCompare, null, replace, replaceAll, split, stripPrefix, stripSuffix, toChar, toCharArray, toLower, toUpper, trim) as StringReExports
import Data.Tuple (Tuple(Tuple))
import Data.Unfoldable (unfoldr)

-- | CodePoint is an Int bounded between 0 and 0x10FFFF, corresponding to
-- | Unicode code points.
newtype CodePoint = CodePoint Int

derive instance eqCodePoint :: Eq CodePoint
derive instance ordCodePoint :: Ord CodePoint

-- I would prefer that this smart constructor not need to exist and instead
-- CodePoint just implements Enum, but the Enum module already depends on this
-- one. To avoid the circular dependency, we just expose these two functions.
codePointFromInt :: Int -> Maybe CodePoint
codePointFromInt n | 0 <= n && n <= 0x10FFFF = Just (CodePoint n)
codePointFromInt n = Nothing

codePointToInt :: CodePoint -> Int
codePointToInt (CodePoint n) = n

unsurrogate :: Int -> Int -> CodePoint
unsurrogate lead trail = CodePoint ((lead - 0xD800) * 0x400 + (trail - 0xDC00) + 0x10000)

isLead :: Int -> Boolean
isLead cu = 0xD800 <= cu && cu <= 0xDBFF

isTrail :: Int -> Boolean
isTrail cu = 0xDC00 <= cu && cu <= 0xDFFF

fromCharCode :: Int -> String
fromCharCode = String.singleton <<< Char.fromCharCode

unsafeCodePointAt0 :: String -> CodePoint
unsafeCodePointAt0 = _unsafeCodePointAt0 unsafeCodePointAt0Fallback

foreign import _unsafeCodePointAt0
  :: (String -> CodePoint)
  -> String
  -> CodePoint

unsafeCodePointAt0Fallback :: String -> CodePoint
unsafeCodePointAt0Fallback s =
  if isLead cu0 && isTrail cu1
     then unsurrogate cu0 cu1
     else CodePoint cu0
  where
    cu0 = Unsafe.charCodeAt 0 s
    cu1 = Unsafe.charCodeAt 1 s

codePointAt :: Int -> String -> Maybe CodePoint
codePointAt 0 "" = Nothing
codePointAt 0 s = Just (unsafeCodePointAt0 s)
codePointAt n s = _codePointAt codePointAtFallback Just Nothing unsafeCodePointAt0 n s

foreign import _codePointAt
  :: (Int -> String -> Maybe CodePoint)
  -> (forall a. a -> Maybe a)
  -> (forall a. Maybe a)
  -> (String -> CodePoint)
  -> Int
  -> String
  -> Maybe CodePoint

codePointAtFallback :: Int -> String -> Maybe CodePoint
codePointAtFallback n s = Array.index (toCodePointArray s) n

count :: (CodePoint -> Boolean) -> String -> Int
count = _count isLead isTrail unsurrogate

foreign import _count
  :: (Int -> Boolean)
  -> (Int -> Boolean)
  -> (Int -> Int -> CodePoint)
  -> (CodePoint -> Boolean)
  -> String
  -> Int

drop :: Int -> String -> String
drop n s = fromCodePointArray (Array.drop n (toCodePointArray s))

dropWhile :: (CodePoint -> Boolean) -> String -> String
dropWhile p s = drop (count p s) s

fromCodePointArray :: Array CodePoint -> String
fromCodePointArray = _fromCodePointArray singletonFallback

foreign import _fromCodePointArray
  :: (CodePoint -> String)
  -> Array CodePoint
  -> String

indexOf :: String.Pattern -> String -> Maybe Int
indexOf p s = (\i -> length (String.take i s)) <$> String.indexOf p s

indexOf' :: String.Pattern -> Int -> String -> Maybe Int
indexOf' p i s =
  let s' = drop i s in
  (\k -> i + length (String.take k s')) <$> String.indexOf p s'

lastIndexOf :: String.Pattern -> String -> Maybe Int
lastIndexOf p s = (\i -> length (String.take i s)) <$> String.lastIndexOf p s

lastIndexOf' :: String.Pattern -> Int -> String -> Maybe Int
lastIndexOf' p i s =
  let s' = drop i s in
  (\k -> i + length (String.take k s')) <$> String.lastIndexOf p s'

length :: String -> Int
length = Array.length <<< toCodePointArray

singleton :: CodePoint -> String
singleton = _singleton singletonFallback

foreign import _singleton
  :: (CodePoint -> String)
  -> CodePoint
  -> String

singletonFallback :: CodePoint -> String
singletonFallback (CodePoint cp) | cp <= 0xFFFF = fromCharCode cp
singletonFallback (CodePoint cp) = fromCharCode lead <> fromCharCode trail
  where
    lead = ((cp - 0x10000) / 0x400) + 0xD800
    trail = (cp - 0x10000) `mod` 0x400 + 0xDC00

splitAt :: Int -> String -> Maybe { before :: String, after :: String }
splitAt i s =
  let cps = toCodePointArray s in
  if i < 0 || Array.length cps < i
    then Nothing
    else Just {
        before: fromCodePointArray (Array.take i cps),
        after: fromCodePointArray (Array.drop i cps)
      }

take :: Int -> String -> String
take = _take takeFallback

foreign import _take :: (Int -> String -> String) -> Int -> String -> String

takeFallback :: Int -> String -> String
takeFallback n s = fromCodePointArray (Array.take n (toCodePointArray s))

takeWhile :: (CodePoint -> Boolean) -> String -> String
takeWhile p s = take (count p s) s

toCodePointArray :: String -> Array CodePoint
toCodePointArray = _toCodePointArray toCodePointArrayFallback unsafeCodePointAt0

foreign import _toCodePointArray
  :: (String -> Array CodePoint)
  -> (String -> CodePoint)
  -> String
  -> Array CodePoint

toCodePointArrayFallback :: String -> Array CodePoint
toCodePointArrayFallback s = unfoldr decode (fromFoldable (Char.toCharCode <$> String.toCharArray s))
  where
  decode :: List Int -> Maybe (Tuple CodePoint (List Int))
  decode (Cons h (Cons l rest)) | isLead h && isTrail l
    = Just (Tuple (unsurrogate h l) rest)
  decode (Cons c rest) = Just (Tuple (CodePoint c) rest)
  decode Nil = Nothing

uncons :: String -> Maybe { head :: CodePoint, tail :: String }
uncons s  = { head: _, tail: drop 1 s } <$> codePointAt 0 s

-- | These functions allow PureScript strings to be treated as if they were
-- | sequences of Unicode code points instead of their true underlying
-- | implementation (sequences of UTF-16 code units). For nearly all uses of
-- | strings, these functions should be preferred over the ones in Data.String.
module Data.String.CodePoints
  ( module StringReExports
  , CodePoint()
  , codePointAt
  , codePointFromInt
  , codePointToInt
  , count
  , drop
  , dropWhile
  , fromCodePointArray
  , indexOf
  , indexOf'
  , lastIndexOf
  , lastIndexOf'
  , length
  , singleton
  , splitAt
  , take
  , takeWhile
  , toCodePointArray
  , uncons
  ) where

import Prelude

import Data.Array as Array
import Data.Char as Char
import Data.List (List(Cons, Nil), fromFoldable)
import Data.Maybe (Maybe(Just, Nothing))
import Data.String as String
import Data.String.Unsafe as Unsafe
-- WARN: This list must be updated to re-export any exports added to Data.String. That makes me sad.
import Data.String (Pattern(..), Replacement(..), charAt, charCodeAt, contains, fromCharArray, joinWith, localeCompare, null, replace, replaceAll, split, stripPrefix, stripSuffix, toChar, toCharArray, toLower, toUpper, trim) as StringReExports
import Data.Tuple (Tuple(Tuple))
import Data.Unfoldable (unfoldr)

-- | CodePoint is an Int bounded between 0 and 0x10FFFF, corresponding to
-- | Unicode code points.
newtype CodePoint = CodePoint Int

derive instance eqCodePoint :: Eq CodePoint
derive instance ordCodePoint :: Ord CodePoint

-- I would prefer that this smart constructor not need to exist and instead
-- CodePoint just implements Enum, but the Enum module already depends on this
-- one. To avoid the circular dependency, we just expose these two functions.
codePointFromInt :: Int -> Maybe CodePoint
codePointFromInt n | 0 <= n && n <= 0x10FFFF = Just (CodePoint n)
codePointFromInt n = Nothing

codePointToInt :: CodePoint -> Int
codePointToInt (CodePoint n) = n

unsurrogate :: Int -> Int -> CodePoint
unsurrogate lead trail = CodePoint ((lead - 0xD800) * 0x400 + (trail - 0xDC00) + 0x10000)

isLead :: Int -> Boolean
isLead cu = 0xD800 <= cu && cu <= 0xDBFF

isTrail :: Int -> Boolean
isTrail cu = 0xDC00 <= cu && cu <= 0xDFFF

fromCharCode :: Int -> String
fromCharCode = String.singleton <<< Char.fromCharCode

unsafeCodePointAt0 :: String -> CodePoint
unsafeCodePointAt0 = _unsafeCodePointAt0 unsafeCodePointAt0Fallback

foreign import _unsafeCodePointAt0
  :: (String -> CodePoint)
  -> String
  -> CodePoint

unsafeCodePointAt0Fallback :: String -> CodePoint
unsafeCodePointAt0Fallback s | String.length s == 1 = CodePoint (Unsafe.charCodeAt 0 s)
unsafeCodePointAt0Fallback s = CodePoint (unsurrogate lead trail)
  where
    lead = Unsafe.charCodeAt 0 s
    trail = Unsafe.charCodeAt 1 s

codePointAt :: Int -> String -> Maybe CodePoint
codePointAt 0 "" = Nothing
codePointAt 0 s = Just (unsafeCodePointAt0 s)
codePointAt n s = _codePointAt codePointAtFallback Just Nothing unsafeCodePointAt0 n s

foreign import _codePointAt
  :: (Int -> String -> Maybe CodePoint)
  -> (forall a. a -> Maybe a)
  -> (forall a. Maybe a)
  -> (String -> CodePoint)
  -> Int
  -> String
  -> Maybe CodePoint

codePointAtFallback :: Int -> String -> Maybe CodePoint
codePointAtFallback n s = Array.index (toCodePointArray s) n

count :: (CodePoint -> Boolean) -> String -> Int
count = _count isLead isTrail unsurrogate

foreign import _count
  :: (Int -> Boolean)
  -> (Int -> Boolean)
  -> (Int -> Int -> CodePoint)
  -> (CodePoint -> Boolean)
  -> String
  -> Int

drop :: Int -> String -> String
drop n s = fromCodePointArray (Array.drop n (toCodePointArray s))

dropWhile :: (CodePoint -> Boolean) -> String -> String
dropWhile p s = drop (count p s) s

fromCodePointArray :: Array CodePoint -> String
fromCodePointArray = _fromCodePointArray singletonFallback

foreign import _fromCodePointArray
  :: (CodePoint -> String)
  -> Array CodePoint
  -> String

indexOf :: String.Pattern -> String -> Maybe Int
indexOf p s = (\i -> length (String.take i s)) <$> String.indexOf p s

indexOf' :: String.Pattern -> Int -> String -> Maybe Int
indexOf' p i s =
  let s' = drop i s in
  (\k -> i + length (String.take k s')) <$> String.indexOf p s'

lastIndexOf :: String.Pattern -> String -> Maybe Int
lastIndexOf p s = (\i -> length (String.take i s)) <$> String.lastIndexOf p s

lastIndexOf' :: String.Pattern -> Int -> String -> Maybe Int
lastIndexOf' p i s =
  let s' = drop i s in
  (\k -> i + length (String.take k s')) <$> String.lastIndexOf p s'

length :: String -> Int
length = Array.length <<< toCodePointArray

singleton :: CodePoint -> String
singleton = _singleton singletonFallback

foreign import _singleton
  :: (CodePoint -> String)
  -> CodePoint
  -> String

singletonFallback :: CodePoint -> String
singletonFallback (CodePoint cp) | cp <= 0xFFFF = fromCharCode cp
singletonFallback (CodePoint cp) = fromCharCode lead <> fromCharCode trail
  where
    lead = ((cp - 0x10000) / 0x400) + 0xD800
    trail = (cp - 0x10000) `mod` 0x400 + 0xDC00

splitAt :: Int -> String -> Maybe { before :: String, after :: String }
splitAt i s =
  let cps = toCodePointArray s in
  if i < 0 || Array.length cps < i
    then Nothing
    else Just {
        before: fromCodePointArray (Array.take i cps),
        after: fromCodePointArray (Array.drop i cps)
      }

take :: Int -> String -> String
take = _take takeFallback

foreign import _take :: (Int -> String -> String) -> Int -> String -> String

takeFallback :: Int -> String -> String
takeFallback n s = fromCodePointArray (Array.take n (toCodePointArray s))

takeWhile :: (CodePoint -> Boolean) -> String -> String
takeWhile p s = take (count p s) s

toCodePointArray :: String -> Array CodePoint
toCodePointArray = _toCodePointArray toCodePointArrayFallback unsafeCodePointAt0

foreign import _toCodePointArray
  :: (String -> Array CodePoint)
  -> (String -> CodePoint)
  -> String
  -> Array CodePoint

toCodePointArrayFallback :: String -> Array CodePoint
toCodePointArrayFallback s = unfoldr decode (fromFoldable (Char.toCharCode <$> String.toCharArray s))
  where
  decode :: List Int -> Maybe (Tuple CodePoint (List Int))
  decode (Cons h (Cons l rest)) | isLead h && isTrail l
    = Just (Tuple (unsurrogate h l) rest)
  decode (Cons c rest) = Just (Tuple (CodePoint c) rest)
  decode Nil = Nothing

uncons :: String -> Maybe { head :: CodePoint, tail :: String }
uncons s  = { head: _, tail: drop 1 s } <$> codePointAt 0 s


Added qualified imports to distinguish string assertions from upcoming Foldable ones.

module Test.Spec.AssertionSpec where

import Prelude
import Control.Monad.Eff.Exception (error)
import Control.Monad.Error.Class (throwError)
import Test.Spec (Spec, describe, it)
import Test.Spec.Assertions.Aff (expectError) as AF
import Test.Spec.Assertions.String (shouldContain, shouldNotContain) as AS
import Test.Spec.Runner (RunnerEffects)

assertionSpec :: ∀ e. Spec (RunnerEffects e) Unit
assertionSpec =
  describe "Test" $
    describe "Spec" $
      describe "Assertions" do

        describe "String" do
          describe "shouldContain" do
            it "accepts strings that contains substrings" $
              "foobar" `AS.shouldContain` "foo"
            it "rejects strings that does not contain substrings" $
              AF.expectError $ "baz" `AS.shouldContain` "foo"

          describe "shouldNotContain" do
            it "accepts strings that does not contain substrings" $
              "foobar" `AS.shouldNotContain` "baz"
            it "rejects strings that contains substrings" $
              AF.expectError $ "bazbar" `AS.shouldNotContain` "baz"

        describe "Aff" $
          describe "expectError" do
            it "returns unit when given an error" $
              AF.expectError $ throwError $ error "omg"
            it "returns an error when given a non-error" $
              AF.expectError $ AF.expectError $ pure "ok"

module Test.Spec.AssertionSpec where

import Prelude
import Control.Monad.Eff.Exception (error)
import Control.Monad.Error.Class (throwError)
import Test.Spec (Spec, describe, it)
import Test.Spec.Assertions.Aff (expectError)
import Test.Spec.Assertions.String (shouldContain, shouldNotContain)
import Test.Spec.Runner (RunnerEffects)

assertionSpec :: ∀ e. Spec (RunnerEffects e) Unit
assertionSpec =
  describe "Test" $
    describe "Spec" $
      describe "Assertions" do

        describe "String" do
          describe "shouldContain" do
            it "accepts strings that contains substrings" $
              "foobar" `shouldContain` "foo"
            it "rejects strings that does not contain substrings" $
              expectError $ "baz" `shouldContain` "foo"

          describe "shouldNotContain" do
            it "accepts strings that does not contain substrings" $
              "foobar" `shouldNotContain` "baz"
            it "rejects strings that contains substrings" $
              expectError $ "bazbar" `shouldNotContain` "baz"

        describe "Aff" $
          describe "expectError" do
            it "returns unit when given an error" $
              expectError $ throwError $ error "omg"
            it "returns an error when given a non-error" $
              expectError $ expectError $ pure "ok"