diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,30 @@ +Copyright (c) 2013, Adam Bergmark + +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + * Redistributions in binary form must reproduce the above + copyright notice, this list of conditions and the following + disclaimer in the documentation and/or other materials provided + with the distribution. + + * Neither the name of Chris Done nor the names of other + contributors may be used to endorse or promote products derived + from this software without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT +LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR +A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT +OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, +SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT +LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, +DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY +THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT +(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE +OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/fay-uri.cabal b/fay-uri.cabal new file mode 100644 --- /dev/null +++ b/fay-uri.cabal @@ -0,0 +1,19 @@ +name: fay-uri +version: 0.2.0.0 +synopsis: Persistent FFI bindings for using jsUri in Fay +homepage: https://github.com/faylang/fay-uri +bug-reports: https://github.com/faylang/fay-uri/issues +license: BSD3 +license-file: LICENSE +author: Adam Bergmark +maintainer: adam@edea.se +copyright: 2013 Adam Bergmark +category: Web +build-type: Simple +cabal-version: >=1.8 +data-files: src/Uri.hs + +library + hs-source-dirs: src + exposed-modules: Uri + build-depends: fay-base diff --git a/src/Uri.hs b/src/Uri.hs new file mode 100644 --- /dev/null +++ b/src/Uri.hs @@ -0,0 +1,138 @@ +{-# Language EmptyDataDecls #-} + +module Uri where + +import FFI +import Prelude + +-- | Creation and conversion + +-- Choose to make Uri an opaque data type. If the accessors on the +-- jsUri objects were properties and not functions we could have +-- defined Uri as a record instead. +data Uri + +-- To make Google Closure play nice we use [] instead of . for accessing properties. +currentUri :: Fay String +currentUri = ffi "window['location']['href']" + +-- This assumes that Uri is defined globally, which it is by default. +newUri :: String -> Uri +newUri = ffi "new window['Uri'](%1)" + +toString :: Uri -> String +toString = ffi "%1['toString']()" + +-- If we ever want to pass a Uri back to JS we need to make sure we keep persistance internally. +clone :: Uri -> Uri +clone = ffi "%1['clone']()" + +-- | Getters + +-- All getters (except query! But lets be consistent) may return null if the value isn't set so we use +-- Language.FFI.Nullable here which converts null -> Null and String -> Nullable String. +-- Nullable is distinguished from Maybe to not break haskell compatibility. +-- If we want to decode null into Nullable (Nullable a) there is no way of +-- knowing if Null or Nullable Null is correct. This problem does not exist when +-- working with Maybe values in client server communication. +protocol :: Uri -> Nullable String +protocol = ffi "%1['protocol']()" + +userInfo :: Uri -> Nullable String +userInfo = ffi "%1['userInfo']()" + +host :: Uri -> Nullable String +host = ffi "%1['host']()" + +port :: Uri -> Nullable String +port = ffi "%1['port']()" + +path :: Uri -> Nullable String +path = ffi "%1['path']()" + +query :: Uri -> Nullable String +query = ffi "%1['query']()" + +anchor :: Uri -> Nullable String +anchor = ffi "%1['anchor']()" + +-- | Other getters + +queryParamValue :: String -> Uri -> String +queryParamValue = ffi "%2['getQueryParamValue'](%1)" + +queryParamValues :: String -> Uri -> [String] +queryParamValues = ffi "%2['getQueryParamValues'](%1)" + +-- | Setters + +-- We could use Nullable here to combine the with* and remove* functions +-- but usage would be more verbose that way. + +-- JsUri has clone() conveniently defined so we use it to get +-- persistence, otherwise our types would be `-> Fay Uri` which is of +-- course worse. + +withProtocol :: String -> Uri -> Uri +withProtocol = ffi "%2['clone']()['setProtocol'](%1)" + +withUserInfo :: String -> Uri -> Uri +withUserInfo = ffi "%2['clone']()['setUserInfo'](%1)" + +withHost :: String -> Uri -> Uri +withHost = ffi "%2['clone']()['setHost'](%1)" + +withPort :: String -> Uri -> Uri +withPort = ffi "%2['clone']()['setPort'](%1)" + +withPath :: String -> Uri -> Uri +withPath = ffi "%2['clone']()['setPath'](%1)" + +withQuery :: String -> Uri -> Uri +withQuery = ffi "%2['clone']()['setQuery'](%1)" + +withAnchor :: String -> Uri -> Uri +withAnchor = ffi "%2['clone']()['setAnchor'](%1)" + +-- | Removals + +removeProtocol :: Uri -> Uri +removeProtocol = ffi "%1['clone']()['setProtocol'](null)" + +removeUserInfo :: Uri -> Uri +removeUserInfo = ffi "%1['clone']()['setUserInfo'](null)" + +removeHost :: Uri -> Uri +removeHost = ffi "%1['clone']()['setHost'](null)" + +removePort :: Uri -> Uri +removePort = ffi "%1['clone']()['setPort'](null)" + +removePath :: Uri -> Uri +removePath = ffi "%1['clone']()['setPath'](null)" + +removeQuery :: Uri -> Uri +removeQuery = ffi "%1['clone']()['setQuery'](null)" + +removeAnchor :: Uri -> Uri +removeAnchor = ffi "%1['clone']()['setAnchor'](null)" + + +-- | Other setters + +addQueryParam :: String -> String -> Uri -> Uri +addQueryParam = ffi "%3['clone']()['addQueryParam'](%1,%2)" + +replaceQueryParam :: String -> String -> Uri -> Uri +replaceQueryParam = ffi "%3['clone']()['replaceQueryParam'](%1,%2)" + +-- The order of the arguments differ from the jsUri api, it is now +-- key -> oldValue -> newValue -> Uri -> Uri +replaceQueryParamValue :: String -> String -> String -> Uri -> Uri +replaceQueryParamValue = ffi "%4['clone']()['replaceQueryParam'](%1, %3, %2)" + +deleteQueryParam :: String -> Uri -> Uri +deleteQueryParam = ffi "%2['clone']()['deleteQueryParam'](%1)" + +deleteQueryParamValue :: String -> String -> Uri -> Uri +deleteQueryParamValue = ffi "%3['clone']()['deleteQueryParam'](%1,%2)"