module Test.WebDriver.Commands.SeleniumSpecific.Mobile (
  -- ** Screen orientation
  getOrientation
  , setOrientation
  , Orientation(..)
  -- ** Geo-location
  , getLocation
  , setLocation
  -- ** Touch gestures
  , touchClick
  , touchDown
  , touchUp
  , touchMove
  , touchScroll
  , touchScrollFrom
  , touchDoubleClick
  , touchLongClick
  , touchFlick
  , touchFlickFrom
  ) where

import Data.Aeson as A
import Data.Aeson.Types
import Data.String (fromString)
import Data.Text (toUpper, toLower)
import GHC.Stack
import Test.WebDriver.JSON
import Test.WebDriver.Types
import Test.WebDriver.Util.Commands


-- | A screen orientation
data Orientation = Landscape | Portrait
                 deriving (Orientation -> Orientation -> Bool
(Orientation -> Orientation -> Bool)
-> (Orientation -> Orientation -> Bool) -> Eq Orientation
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Orientation -> Orientation -> Bool
== :: Orientation -> Orientation -> Bool
$c/= :: Orientation -> Orientation -> Bool
/= :: Orientation -> Orientation -> Bool
Eq, Int -> Orientation -> ShowS
[Orientation] -> ShowS
Orientation -> String
(Int -> Orientation -> ShowS)
-> (Orientation -> String)
-> ([Orientation] -> ShowS)
-> Show Orientation
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Orientation -> ShowS
showsPrec :: Int -> Orientation -> ShowS
$cshow :: Orientation -> String
show :: Orientation -> String
$cshowList :: [Orientation] -> ShowS
showList :: [Orientation] -> ShowS
Show, Eq Orientation
Eq Orientation =>
(Orientation -> Orientation -> Ordering)
-> (Orientation -> Orientation -> Bool)
-> (Orientation -> Orientation -> Bool)
-> (Orientation -> Orientation -> Bool)
-> (Orientation -> Orientation -> Bool)
-> (Orientation -> Orientation -> Orientation)
-> (Orientation -> Orientation -> Orientation)
-> Ord Orientation
Orientation -> Orientation -> Bool
Orientation -> Orientation -> Ordering
Orientation -> Orientation -> Orientation
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Orientation -> Orientation -> Ordering
compare :: Orientation -> Orientation -> Ordering
$c< :: Orientation -> Orientation -> Bool
< :: Orientation -> Orientation -> Bool
$c<= :: Orientation -> Orientation -> Bool
<= :: Orientation -> Orientation -> Bool
$c> :: Orientation -> Orientation -> Bool
> :: Orientation -> Orientation -> Bool
$c>= :: Orientation -> Orientation -> Bool
>= :: Orientation -> Orientation -> Bool
$cmax :: Orientation -> Orientation -> Orientation
max :: Orientation -> Orientation -> Orientation
$cmin :: Orientation -> Orientation -> Orientation
min :: Orientation -> Orientation -> Orientation
Ord, Orientation
Orientation -> Orientation -> Bounded Orientation
forall a. a -> a -> Bounded a
$cminBound :: Orientation
minBound :: Orientation
$cmaxBound :: Orientation
maxBound :: Orientation
Bounded, Int -> Orientation
Orientation -> Int
Orientation -> [Orientation]
Orientation -> Orientation
Orientation -> Orientation -> [Orientation]
Orientation -> Orientation -> Orientation -> [Orientation]
(Orientation -> Orientation)
-> (Orientation -> Orientation)
-> (Int -> Orientation)
-> (Orientation -> Int)
-> (Orientation -> [Orientation])
-> (Orientation -> Orientation -> [Orientation])
-> (Orientation -> Orientation -> [Orientation])
-> (Orientation -> Orientation -> Orientation -> [Orientation])
-> Enum Orientation
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: Orientation -> Orientation
succ :: Orientation -> Orientation
$cpred :: Orientation -> Orientation
pred :: Orientation -> Orientation
$ctoEnum :: Int -> Orientation
toEnum :: Int -> Orientation
$cfromEnum :: Orientation -> Int
fromEnum :: Orientation -> Int
$cenumFrom :: Orientation -> [Orientation]
enumFrom :: Orientation -> [Orientation]
$cenumFromThen :: Orientation -> Orientation -> [Orientation]
enumFromThen :: Orientation -> Orientation -> [Orientation]
$cenumFromTo :: Orientation -> Orientation -> [Orientation]
enumFromTo :: Orientation -> Orientation -> [Orientation]
$cenumFromThenTo :: Orientation -> Orientation -> Orientation -> [Orientation]
enumFromThenTo :: Orientation -> Orientation -> Orientation -> [Orientation]
Enum)

instance ToJSON Orientation where
  toJSON :: Orientation -> Value
toJSON = Text -> Value
String (Text -> Value) -> (Orientation -> Text) -> Orientation -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
toUpper (Text -> Text) -> (Orientation -> Text) -> Orientation -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
forall a. IsString a => String -> a
fromString (String -> Text) -> (Orientation -> String) -> Orientation -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Orientation -> String
forall a. Show a => a -> String
show

instance FromJSON Orientation where
  parseJSON :: Value -> Parser Orientation
parseJSON (String Text
jStr) = case Text -> Text
toLower Text
jStr of
    Text
"landscape" -> Orientation -> Parser Orientation
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return Orientation
Landscape
    Text
"portrait"  -> Orientation -> Parser Orientation
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return Orientation
Portrait
    Text
err         -> String -> Parser Orientation
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser Orientation) -> String -> Parser Orientation
forall a b. (a -> b) -> a -> b
$ String
"Invalid Orientation string " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Text -> String
forall a. Show a => a -> String
show Text
err
  parseJSON Value
v = String -> Value -> Parser Orientation
forall a. String -> Value -> Parser a
typeMismatch String
"Orientation" Value
v

-- | Get the current screen orientation for rotatable display devices.
getOrientation :: (HasCallStack, WebDriver wd) => wd Orientation
getOrientation :: forall (wd :: * -> *).
(HasCallStack, WebDriver wd) =>
wd Orientation
getOrientation = Method -> Text -> Value -> wd Orientation
forall (wd :: * -> *) a b.
(HasCallStack, WebDriver wd, ToJSON a, FromJSON b) =>
Method -> Text -> a -> wd b
doSessCommand Method
methodGet Text
"/orientation" Value
Null

-- | Set the current screen orientation for rotatable display devices.
setOrientation :: (HasCallStack, WebDriver wd) => Orientation -> wd ()
setOrientation :: forall (wd :: * -> *).
(HasCallStack, WebDriver wd) =>
Orientation -> wd ()
setOrientation = wd NoReturn -> wd ()
forall (m :: * -> *). WebDriver m => m NoReturn -> m ()
noReturn (wd NoReturn -> wd ())
-> (Orientation -> wd NoReturn) -> Orientation -> wd ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Method -> Text -> Value -> wd NoReturn
forall (wd :: * -> *) a b.
(HasCallStack, WebDriver wd, ToJSON a, FromJSON b) =>
Method -> Text -> a -> wd b
doSessCommand Method
methodPost Text
"/orientation" (Value -> wd NoReturn)
-> (Orientation -> Value) -> Orientation -> wd NoReturn
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Orientation -> Value
forall a. ToJSON a => Text -> a -> Value
single Text
"orientation"

-- | Single tap on the touch screen at the given element's location.
touchClick :: (HasCallStack, WebDriver wd) => Element -> wd ()
touchClick :: forall (wd :: * -> *).
(HasCallStack, WebDriver wd) =>
Element -> wd ()
touchClick (Element Text
e) =
  wd NoReturn -> wd ()
forall (m :: * -> *). WebDriver m => m NoReturn -> m ()
noReturn (wd NoReturn -> wd ()) -> (Text -> wd NoReturn) -> Text -> wd ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Method -> Text -> Value -> wd NoReturn
forall (wd :: * -> *) a b.
(HasCallStack, WebDriver wd, ToJSON a, FromJSON b) =>
Method -> Text -> a -> wd b
doSessCommand Method
methodPost Text
"/touch/click" (Value -> wd NoReturn) -> (Text -> Value) -> Text -> wd NoReturn
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text -> Value
forall a. ToJSON a => Text -> a -> Value
single Text
"element" (Text -> wd ()) -> Text -> wd ()
forall a b. (a -> b) -> a -> b
$ Text
e

-- | Emulates pressing a finger down on the screen at the given location.
touchDown :: (HasCallStack, WebDriver wd) => (Int, Int) -> wd ()
touchDown :: forall (wd :: * -> *).
(HasCallStack, WebDriver wd) =>
(Int, Int) -> wd ()
touchDown = wd NoReturn -> wd ()
forall (m :: * -> *). WebDriver m => m NoReturn -> m ()
noReturn (wd NoReturn -> wd ())
-> ((Int, Int) -> wd NoReturn) -> (Int, Int) -> wd ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Method -> Text -> Value -> wd NoReturn
forall (wd :: * -> *) a b.
(HasCallStack, WebDriver wd, ToJSON a, FromJSON b) =>
Method -> Text -> a -> wd b
doSessCommand Method
methodPost Text
"/touch/down" (Value -> wd NoReturn)
-> ((Int, Int) -> Value) -> (Int, Int) -> wd NoReturn
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text, Text) -> (Int, Int) -> Value
forall a b. (ToJSON a, ToJSON b) => (Text, Text) -> (a, b) -> Value
pair (Text
"x",Text
"y")

-- | Emulates removing a finger from the screen at the given location.
touchUp :: (HasCallStack, WebDriver wd) => (Int, Int) -> wd ()
touchUp :: forall (wd :: * -> *).
(HasCallStack, WebDriver wd) =>
(Int, Int) -> wd ()
touchUp = wd NoReturn -> wd ()
forall (m :: * -> *). WebDriver m => m NoReturn -> m ()
noReturn (wd NoReturn -> wd ())
-> ((Int, Int) -> wd NoReturn) -> (Int, Int) -> wd ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Method -> Text -> Value -> wd NoReturn
forall (wd :: * -> *) a b.
(HasCallStack, WebDriver wd, ToJSON a, FromJSON b) =>
Method -> Text -> a -> wd b
doSessCommand Method
methodPost Text
"/touch/up" (Value -> wd NoReturn)
-> ((Int, Int) -> Value) -> (Int, Int) -> wd NoReturn
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text, Text) -> (Int, Int) -> Value
forall a b. (ToJSON a, ToJSON b) => (Text, Text) -> (a, b) -> Value
pair (Text
"x",Text
"y")

-- | Emulates moving a finger on the screen to the given location.
touchMove :: (HasCallStack, WebDriver wd) => (Int, Int) -> wd ()
touchMove :: forall (wd :: * -> *).
(HasCallStack, WebDriver wd) =>
(Int, Int) -> wd ()
touchMove = wd NoReturn -> wd ()
forall (m :: * -> *). WebDriver m => m NoReturn -> m ()
noReturn (wd NoReturn -> wd ())
-> ((Int, Int) -> wd NoReturn) -> (Int, Int) -> wd ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Method -> Text -> Value -> wd NoReturn
forall (wd :: * -> *) a b.
(HasCallStack, WebDriver wd, ToJSON a, FromJSON b) =>
Method -> Text -> a -> wd b
doSessCommand Method
methodPost Text
"/touch/move" (Value -> wd NoReturn)
-> ((Int, Int) -> Value) -> (Int, Int) -> wd NoReturn
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text, Text) -> (Int, Int) -> Value
forall a b. (ToJSON a, ToJSON b) => (Text, Text) -> (a, b) -> Value
pair (Text
"x",Text
"y")

-- | Emulate finger-based touch scroll. Use this function if you don't care where
-- the scroll begins
touchScroll :: (HasCallStack, WebDriver wd) => (Int, Int) -> wd ()
touchScroll :: forall (wd :: * -> *).
(HasCallStack, WebDriver wd) =>
(Int, Int) -> wd ()
touchScroll = wd NoReturn -> wd ()
forall (m :: * -> *). WebDriver m => m NoReturn -> m ()
noReturn (wd NoReturn -> wd ())
-> ((Int, Int) -> wd NoReturn) -> (Int, Int) -> wd ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Method -> Text -> Value -> wd NoReturn
forall (wd :: * -> *) a b.
(HasCallStack, WebDriver wd, ToJSON a, FromJSON b) =>
Method -> Text -> a -> wd b
doSessCommand Method
methodPost Text
"/touch/scroll" (Value -> wd NoReturn)
-> ((Int, Int) -> Value) -> (Int, Int) -> wd NoReturn
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text, Text) -> (Int, Int) -> Value
forall a b. (ToJSON a, ToJSON b) => (Text, Text) -> (a, b) -> Value
pair (Text
"xoffset",Text
"yoffset")

-- | Emulate finger-based touch scroll, starting from the given location relative
-- to the given element.
touchScrollFrom :: (HasCallStack, WebDriver wd) => (Int, Int) -> Element -> wd ()
touchScrollFrom :: forall (wd :: * -> *).
(HasCallStack, WebDriver wd) =>
(Int, Int) -> Element -> wd ()
touchScrollFrom (Int
x, Int
y) (Element Text
e) =
  wd NoReturn -> wd ()
forall (m :: * -> *). WebDriver m => m NoReturn -> m ()
noReturn
  (wd NoReturn -> wd ())
-> ((Int, Int, Text) -> wd NoReturn) -> (Int, Int, Text) -> wd ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Method -> Text -> Value -> wd NoReturn
forall (wd :: * -> *) a b.
(HasCallStack, WebDriver wd, ToJSON a, FromJSON b) =>
Method -> Text -> a -> wd b
doSessCommand Method
methodPost Text
"/touch/scroll"
  (Value -> wd NoReturn)
-> ((Int, Int, Text) -> Value) -> (Int, Int, Text) -> wd NoReturn
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text, Text, Text) -> (Int, Int, Text) -> Value
forall a b c.
(ToJSON a, ToJSON b, ToJSON c) =>
(Text, Text, Text) -> (a, b, c) -> Value
triple (Text
"xoffset", Text
"yoffset", Text
"element")
  ((Int, Int, Text) -> wd ()) -> (Int, Int, Text) -> wd ()
forall a b. (a -> b) -> a -> b
$ (Int
x, Int
y, Text
e)

-- | Emulate a double click on a touch device.
touchDoubleClick :: (HasCallStack, WebDriver wd) => Element -> wd ()
touchDoubleClick :: forall (wd :: * -> *).
(HasCallStack, WebDriver wd) =>
Element -> wd ()
touchDoubleClick (Element Text
e) =
  wd NoReturn -> wd ()
forall (m :: * -> *). WebDriver m => m NoReturn -> m ()
noReturn
  (wd NoReturn -> wd ()) -> (Text -> wd NoReturn) -> Text -> wd ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Method -> Text -> Value -> wd NoReturn
forall (wd :: * -> *) a b.
(HasCallStack, WebDriver wd, ToJSON a, FromJSON b) =>
Method -> Text -> a -> wd b
doSessCommand Method
methodPost Text
"/touch/doubleclick"
  (Value -> wd NoReturn) -> (Text -> Value) -> Text -> wd NoReturn
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text -> Value
forall a. ToJSON a => Text -> a -> Value
single Text
"element" (Text -> wd ()) -> Text -> wd ()
forall a b. (a -> b) -> a -> b
$ Text
e

-- | Emulate a long click on a touch device.
touchLongClick :: (HasCallStack, WebDriver wd) => Element -> wd ()
touchLongClick :: forall (wd :: * -> *).
(HasCallStack, WebDriver wd) =>
Element -> wd ()
touchLongClick (Element Text
e) =
  wd NoReturn -> wd ()
forall (m :: * -> *). WebDriver m => m NoReturn -> m ()
noReturn
  (wd NoReturn -> wd ()) -> (Text -> wd NoReturn) -> Text -> wd ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Method -> Text -> Value -> wd NoReturn
forall (wd :: * -> *) a b.
(HasCallStack, WebDriver wd, ToJSON a, FromJSON b) =>
Method -> Text -> a -> wd b
doSessCommand Method
methodPost Text
"/touch/longclick"
  (Value -> wd NoReturn) -> (Text -> Value) -> Text -> wd NoReturn
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text -> Value
forall a. ToJSON a => Text -> a -> Value
single Text
"element" (Text -> wd ()) -> Text -> wd ()
forall a b. (a -> b) -> a -> b
$ Text
e
-- | Emulate a flick on the touch screen. The coordinates indicate x and y
-- velocity, respectively. Use this function if you don't care where the
-- flick starts.
touchFlick :: (HasCallStack, WebDriver wd) => (Int, Int) -> wd ()
touchFlick :: forall (wd :: * -> *).
(HasCallStack, WebDriver wd) =>
(Int, Int) -> wd ()
touchFlick =
  wd NoReturn -> wd ()
forall (m :: * -> *). WebDriver m => m NoReturn -> m ()
noReturn
  (wd NoReturn -> wd ())
-> ((Int, Int) -> wd NoReturn) -> (Int, Int) -> wd ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Method -> Text -> Value -> wd NoReturn
forall (wd :: * -> *) a b.
(HasCallStack, WebDriver wd, ToJSON a, FromJSON b) =>
Method -> Text -> a -> wd b
doSessCommand Method
methodPost Text
"/touch/flick"
  (Value -> wd NoReturn)
-> ((Int, Int) -> Value) -> (Int, Int) -> wd NoReturn
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text, Text) -> (Int, Int) -> Value
forall a b. (ToJSON a, ToJSON b) => (Text, Text) -> (a, b) -> Value
pair (Text
"xSpeed", Text
"ySpeed")

-- | Emulate a flick on the touch screen.
touchFlickFrom :: (HasCallStack, WebDriver wd) =>
                  Int           -- ^ flick velocity
                  -> (Int, Int) -- ^ a location relative to the given element
                  -> Element    -- ^ the given element
                  -> wd ()
touchFlickFrom :: forall (wd :: * -> *).
(HasCallStack, WebDriver wd) =>
Int -> (Int, Int) -> Element -> wd ()
touchFlickFrom Int
s (Int
x,Int
y) (Element Text
e) =
  wd NoReturn -> wd ()
forall (m :: * -> *). WebDriver m => m NoReturn -> m ()
noReturn
  (wd NoReturn -> wd ())
-> ([Pair] -> wd NoReturn) -> [Pair] -> wd ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Method -> Text -> Value -> wd NoReturn
forall (wd :: * -> *) a b.
(HasCallStack, WebDriver wd, ToJSON a, FromJSON b) =>
Method -> Text -> a -> wd b
doSessCommand Method
methodPost Text
"/touch/flick" (Value -> wd NoReturn)
-> ([Pair] -> Value) -> [Pair] -> wd NoReturn
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Pair] -> Value
object ([Pair] -> wd ()) -> [Pair] -> wd ()
forall a b. (a -> b) -> a -> b
$
  [Key
"xoffset" Key -> Int -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Int
x
  ,Key
"yoffset" Key -> Int -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Int
y
  ,Key
"speed"   Key -> Int -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Int
s
  ,Key
"element" Key -> Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text
e
  ]

-- | Get the current geographical location of the device.
getLocation :: (HasCallStack, WebDriver wd) => wd (Int, Int, Int)
getLocation :: forall (wd :: * -> *).
(HasCallStack, WebDriver wd) =>
wd (Int, Int, Int)
getLocation = Method -> Text -> Value -> wd Value
forall (wd :: * -> *) a b.
(HasCallStack, WebDriver wd, ToJSON a, FromJSON b) =>
Method -> Text -> a -> wd b
doSessCommand Method
methodGet Text
"/location" Value
Null
  wd Value -> (Value -> wd (Int, Int, Int)) -> wd (Int, Int, Int)
forall a b. wd a -> (a -> wd b) -> wd b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> String -> String -> String -> Value -> wd (Int, Int, Int)
forall (m :: * -> *) a b c.
(MonadIO m, FromJSON a, FromJSON b, FromJSON c) =>
String -> String -> String -> String -> Value -> m (a, b, c)
parseTriple String
"latitude" String
"longitude" String
"altitude" String
"getLocation"

-- | Set the current geographical location of the device.
setLocation :: (HasCallStack, WebDriver wd) => (Int, Int, Int) -> wd ()
setLocation :: forall (wd :: * -> *).
(HasCallStack, WebDriver wd) =>
(Int, Int, Int) -> wd ()
setLocation = wd NoReturn -> wd ()
forall (m :: * -> *). WebDriver m => m NoReturn -> m ()
noReturn (wd NoReturn -> wd ())
-> ((Int, Int, Int) -> wd NoReturn) -> (Int, Int, Int) -> wd ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Method -> Text -> Value -> wd NoReturn
forall (wd :: * -> *) a b.
(HasCallStack, WebDriver wd, ToJSON a, FromJSON b) =>
Method -> Text -> a -> wd b
doSessCommand Method
methodPost Text
"/location"
              (Value -> wd NoReturn)
-> ((Int, Int, Int) -> Value) -> (Int, Int, Int) -> wd NoReturn
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text, Text, Text) -> (Int, Int, Int) -> Value
forall a b c.
(ToJSON a, ToJSON b, ToJSON c) =>
(Text, Text, Text) -> (a, b, c) -> Value
triple (Text
"latitude",
                        Text
"longitude",
                        Text
"altitude")