-- | Represent a value in degrees, minutes and seconds.
module Data.Geo.DMS(
                     DMS,
                     positive,
                     degrees,
                     minutes,
                     seconds,
                     dms,
                     DMSable,
                     toDMS,
                     fromDMS,
                     showNegPos,
                     showDMS,
                     coordDMS
                   ) where

import Data.Geo.Latitude
import Data.Geo.Longitude
import Data.Geo.Coord
import Data.Geo.Accessor.Value
import Data.Geo.Accessor.Lat
import Data.Geo.Accessor.Lon
import Control.Arrow
import Text.Printf
import Data.List

-- | The structure of a type convertible to degrees, minutes and seconds.
data DMS = DMS {
  positive :: Bool,
  degrees :: Int,
  minutes :: Int,
  seconds :: Double
} deriving (Eq, Ord, Show)

-- | Construct a value of degrees, minutes and seconds.
dms :: Bool -> Int -> Int -> Double -> DMS
dms p d m s = DMS p (abs d) (abs m) (abs s)

class DMSable a where
  toDMS :: a -> DMS
  fromDMS :: DMS -> a
  showNegPos :: a -> String

instance DMSable Latitude where
  toDMS = toDMS' . value
  fromDMS = latitude . fromDMS'
  showNegPos x = if value x < 0 then "S" else "N"

instance DMSable Longitude where
  toDMS = toDMS' . value
  fromDMS = longitude . fromDMS'
  showNegPos x = if value x < 0 then "W" else "E"

-- | Show a value in degrees, minutes and seconds.
showDMS :: (DMSable a) => a -> String
showDMS x = let DMS _ d m s = toDMS x
                d' = show d
                m' = show m
                s' = printf "%.5f" s
                suffix = showNegPos x
            in intercalate "," [d', m', s'] ++ suffix

-- | Show a coordinate in degrees, minutes and seconds.
coordDMS :: Coord -> String
coordDMS = show . (showDMS *** showDMS) . (lat &&& lon)

-- not exported
fromDMS' :: DMS -> Double
fromDMS' d = let s = seconds d / 3600
                 m = (/ 60) . fromIntegral . minutes $ d
                 d' = fromIntegral . degrees $ d
                 z = if positive d then id else negate
             in z $ s + m + d'

-- not exported
toDMS' :: Double -> DMS
toDMS' x = let (n, f) = second abs . properFraction $ x
               (m, g) = properFraction . (* 60) $ f
           in dms (n >= 0) n m (g * 60)