Seconds.hs

{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE FlexibleInstances #-}

module Data.Geo.Coordinate.Seconds(
  Seconds
, AsSeconds(..)
, modSeconds
) where

import Control.Applicative(Applicative)
import Control.Category(Category(id))
import Control.Lens(prism', Optic', Choice)
import Data.Bool((&&))
import Data.Eq(Eq)
import Data.Int(Int)
import Data.Fixed(divMod')
import Data.Ord(Ord((>), (>=), (<)))
import Data.Maybe(Maybe(Just, Nothing))
import Data.List((++))
import Data.Tuple(snd)
import Prelude(Double, Show(showsPrec), showParen, showString)
import Text.Printf(printf)

-- $setup
-- >>> import Control.Lens((#), (^?), (^.))
-- >>> import Data.Foldable(all)
-- >>> import Prelude(Eq(..))

newtype Seconds =
  Seconds Double
  deriving (Eq, Ord)

-- | A show instance that prints to 4 decimal places.
-- This is to take floating-point rounding errors into account.
instance Show Seconds where
  showsPrec n (Seconds d) =
    showParen (n > 10) (showString ("Seconds " ++ printf "%0.4f" d))

class AsSeconds p f s where
  _Seconds ::
    Optic' p f s Seconds

instance AsSeconds p f Seconds where
  _Seconds =
    id

-- | A prism on seconds to a double between 0 inclusive and 60 exclusive.
--
-- >>> (7 :: Double) ^? _Seconds
-- Just (Seconds 7.0000)
--
-- >>> (0 :: Double) ^? _Seconds
-- Just (Seconds 0.0000)
--
-- >>> (59 :: Double) ^? _Seconds
-- Just (Seconds 59.0000)
--
-- >>> (59.99 :: Double) ^? _Seconds
-- Just (Seconds 59.9900)
--
-- >>> (60 :: Double) ^? _Seconds
-- Nothing
--
-- prop> all (\m -> _Seconds # m == (n :: Double)) (n ^? _Seconds)
instance (Choice p, Applicative f) => AsSeconds p f Double where
  _Seconds =
    prism'
      (\(Seconds d) -> d)
      (\d -> if d >= 0 && d < 60
               then Just (Seconds d)
               else Nothing)

-- | Setting a value within the range @0@ and @60@ using modulo arithmetic.
--
-- >>> modSeconds 7
-- Seconds 7.0000
--
-- >>> modSeconds 0
-- Seconds 0.0000
--
-- >>> modSeconds (-0.0001)
-- Seconds 59.9999
--
-- >>> modSeconds 60
-- Seconds 0.0000
--
-- >>> modSeconds 59.99999
-- Seconds 60.0000
--
-- >>> modSeconds 59.999
-- Seconds 59.9990
--
-- >>> modSeconds 61
-- Seconds 1.0000
--
-- >>> modSeconds (-1)
-- Seconds 59.0000
modSeconds ::
  Double
  -> Seconds
modSeconds x =
  Seconds (snd (x `divMod'` 60.0 :: (Int, Double)))