{-# OPTIONS_GHC -fwarn-incomplete-patterns  #-}
{-# OPTIONS_GHC -fwarn-missing-methods      #-}     
{-# LANGUAGE DeriveDataTypeable             #-}
{-# LANGUAGE DeriveFunctor                  #-}
{-# LANGUAGE GeneralizedNewtypeDeriving     #-}
{-# LANGUAGE PatternGuards                  #-}
{-# LANGUAGE TemplateHaskell                #-} 

module Facts.Geography.Location ( DMS       (..)
                                , Length    (..)
                                , Location  (..)
                                , Latitude  (..)
                                , Longitude (..)
                                ) where

import Data.Angle
import Data.Data
import Data.Typeable

import Facts.Utility.OrphanInstances


data DMS = DMS { degrees  ::  Double
               , minutes  ::  Double
               , seconds  ::  Double
               } deriving (Data, Eq, Ord, Show, Typeable)


data Length = Meters Double
            | Feet   Double
            deriving (Data, Eq, Ord, Show, Typeable)


newtype Latitude  = Latitude  (Degrees Double) deriving (Data, Eq, Ord, Show, Typeable)
newtype Longitude = Longitude (Degrees Double) deriving (Data, Eq, Ord, Show, Typeable)


-- | Elevation from sea level.
type Elevation = Length


data Location = Location { latitude  :: Latitude
                         , longitude :: Longitude
                         , elevation :: Maybe Elevation
                         } deriving (Data, Eq, Ord, Show, Typeable)



dms_to_degrees :: DMS -> Degrees Double
dms_to_degrees (DMS d m s) = Degrees (d + m / 60 + s / 3600)

dms_to_latitude  :: DMS -> Latitude
dms_to_longitude :: DMS -> Longitude
dms_to_latitude  = Latitude  . dms_to_degrees
dms_to_longitude = Longitude . dms_to_degrees

dms_lat_long_to_location_at_sea_level :: (DMS, DMS) -> Location
dms_lat_long_to_location_at_sea_level (lat, lon) = Location { latitude  = dms_to_latitude  $ lat
                                                            , longitude = dms_to_longitude $ lon
                                                            , elevation = Nothing
                                                            }