diff --git a/CHANGELOG.md b/CHANGELOG.md new file mode 100644 --- /dev/null +++ b/CHANGELOG.md @@ -0,0 +1,5 @@ +## Changelog + +## 0.1.0.0 (2015-05-31) + +* Initial release diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,30 @@ +Copyright (c) 2015, Edward O'Callaghan + +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 Edward O'Callaghan 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/README.md b/README.md new file mode 100644 --- /dev/null +++ b/README.md @@ -0,0 +1,6 @@ +## Readme + +## Introduction + +fay-geoposition provides the GeoPosition API found within the W3C specification +within the Fay Monad. 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-geoposition.cabal b/fay-geoposition.cabal new file mode 100644 --- /dev/null +++ b/fay-geoposition.cabal @@ -0,0 +1,41 @@ +name: fay-geoposition + +-- The package version. See the Haskell package versioning policy (PVP) +-- for standards guiding when and how versions should be incremented. +-- http://www.haskell.org/haskellwiki/Package_versioning_policy +-- PVP summary: +-+------- breaking API changes +-- | | +----- non-breaking API additions +-- | | | +--- code changes with no API change +version: 0.1.0.0 + +synopsis: W3C compliant implementation of GeoPosition API. +description: W3C compliant implementation of GeoPosition API within the Fay Monad +homepage: https://github.com/victoredwardocallaghan/fay-geoposition +bug-reports: https://github.com/victoredwardocallaghan/fay-geoposition/issues +license: BSD3 +license-file: LICENSE +author: Edward O'Callaghan +maintainer: eocallaghan@alterapraxis.com +-- copyright: +category: Web +build-type: Simple +data-files: src/Fay/GeoPosition.hs +cabal-version: >=1.10 +extra-source-files: + LICENSE + CHANGELOG.md + README.md + +library + exposed: False + exposed-modules: Fay.GeoPosition + other-extensions: CPP, DeriveDataTypeable, FlexibleInstances, StandaloneDeriving + build-depends: base >=4.7 && <4.8, time >=1.4 && <1.5, + fay, fay-text + hs-source-dirs: src + default-language: Haskell2010 + ghc-options: -Wall + +source-repository head + type: git + location: https://github.com/victoredwardocallaghan/fay-geoposition.git diff --git a/src/Fay/GeoPosition.hs b/src/Fay/GeoPosition.hs new file mode 100644 --- /dev/null +++ b/src/Fay/GeoPosition.hs @@ -0,0 +1,132 @@ +{-| + Module : $Header$ + Copyright : (c) 2015 Altera Praxis Pty Ltd + License : BSD + Maintainer : eocallaghan@alterapraxis.com + Stability : provisional + Portability : portable + + This module encapsulates Fay Javascript for the + GeoPosition API specified as in the W3C spec. +-} + +{-# LANGUAGE CPP #-} +{-# LANGUAGE DeriveDataTypeable #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE StandaloneDeriving #-} + +module Fay.GeoPosition ( geoPositionErrorMessage + , geoPositionErrorCode +#ifdef FAY + , initGeoPosition +#endif + , GeoPositionCallbacks(..) + , GeoPositionOptions(..) + , GeoPosition(..) + , GeoCoordinates(..) + , GeoPositionError(..) + , GeoPositionErrorCode(..) + ) where + + + +import Fay.Text (Text,unpack) +#ifdef FAY +import FFI +import Data.Nullable (toNullable) +#endif +import Data.Time (UTCTime) +import Data.Data +import Prelude + + +#ifdef FAY +-- | Call to initialise GeoPosition API with callback +-- actions to be taken upon success or error. +initGeoPosition :: GeoPositionCallbacks Fay + -> Maybe GeoPositionOptions + -> Fay () +initGeoPosition gpc gpo = do + getCurrentPosition' gpc's gpc'e gpc'o + where getCurrentPosition' :: GeoPositionCallback Fay + -> Nullable (GeoPositionErrorCallback Fay) + -> Nullable GeoPositionOptions + -> Fay () + getCurrentPosition' = ffi "navigator.geolocation.getCurrentPosition(%1,%2,%3)" + gpc's = geoPositionCallback gpc + gpc'e = toNullable (geoPositionErrorCallback gpc) + gpc'o = toNullable gpo + +#endif + + +-- | See section [5.1 - W3C Geolocation API] +-- Requires the monad type that the callbacks have action on +data GeoPositionCallbacks m = GeoPositionCallbacks { geoPositionCallback :: GeoPositionCallback m + , geoPositionErrorCallback :: Maybe (GeoPositionErrorCallback m) + } + +type GeoPositionCallback m = GeoPosition -> m () +type GeoPositionErrorCallback m = GeoPositionError -> m () + +-- | See section [5.2 - W3C Geolocation API] +data GeoPositionOptions = + GeoPositionOptions { -- | Is a 'Bool' that indicates the application would + -- like to receive the best possible results. + enableHighAccuracy :: Bool + -- | Maximum length of time (in milliseconds) the device + -- is allowed to take in order to return a position. + , timeout :: Int + -- | Maximum age in milliseconds of a possible cached + -- position that is acceptable to return. + , maximumAge :: Int + } deriving Eq + +-- | See section [5.3 - W3C Geolocation API] +data GeoPosition = GeoPosition { coords :: GeoCoordinates -- ^ Coordinates object defining the current location + , timestamp :: UTCTime -- ^ DOMTimeStamp, time at which location was retrieved + } deriving (Show,Data,Typeable) + +-- | See section [5.4 - W3C Geolocation API] +data GeoCoordinates = GeoCoordinates { latitude :: Double -- ^ decimal degrees + , longitude :: Double -- ^ decimal degrees + , altitude :: Maybe Double -- ^ meters above the reference ellipsoid + , accuracy :: Double -- ^ meters + , altitudeAccuracy :: Maybe Double -- ^ meters + , heading :: Maybe Double -- ^ degrees clockwise from true north + , speed :: Maybe Double -- ^ meters/second + } deriving (Read,Show,Data,Typeable) + +-- | See section [5.5 - W3C Geolocation API] +data GeoPositionError = GeoPositionError { code :: Int -- ^ Enumerated code, see 'GeoPositionErrorCode' + , message :: Text -- ^ Human readable 'UTF-16 DOMString' for debugging + } deriving (Read,Show,Data,Typeable) + +-- | N.B. Fay does not support the Enum type class :( +-- Thus, use the 'geoPositionErrorCode' function to decode the value to the +-- 'GeoPositionErrorCode' type. +data GeoPositionErrorCode + -- | The acquisition of the geolocation information failed because the page + -- didn't have the permission to do it. + = PermissionDenied + -- | The acquisition of the geolocation failed because at least one internal + -- source of position returned an internal error. + | PositionUnavailable + -- | The time allowed to acquire the geolocation, defined by 'timeout' + -- information was reached before the information was obtained. + | Timeout + -- | Out of spec error code + | Unknown + deriving (Eq) + +-- | Helper function extracts UTC-16 encoded error message +geoPositionErrorMessage :: GeoPositionError -> String +geoPositionErrorMessage = unpack . message + +-- | Helper function decodes enumerated error 'code' into the 'GeoPositionErrorCode' type +geoPositionErrorCode :: GeoPositionError -> GeoPositionErrorCode +geoPositionErrorCode = decode . code + where decode e | e == 1 = PermissionDenied + | e == 2 = PositionUnavailable + | e == 3 = Timeout + | otherwise = Unknown