ttc-0.1.0.0: examples/Duration.hs

------------------------------------------------------------------------------
-- |
-- Module      : Duration
-- Description : duration data type
-- Copyright   : Copyright (c) 2019 Travis Cardwell
-- License     : MIT
--
-- This module defines a duration data type, with 'TTC.Render' and 'TTC.Parse'
-- instances, as an example of TTC usage.
--
-- The constructor for 'Duration' is not exported.  The 'TTC.Parse' instance
-- serves as a "smart constructor," ensuring that all values are valid.
------------------------------------------------------------------------------

{-# LANGUAGE TemplateHaskell #-}

module Duration
  ( -- * Type
    Duration
    -- * API
  , fromDouble
  , fromFloat
  , fromInt
  , fromMicro
  , fromNominalDiffTime
  , fromReal
  , toDouble
  , toFloat
  , toInt
  , toIntegral
  , toMicro
  , toNominalDiffTime
  , valid
  ) where

-- https://hackage.haskell.org/package/base
import Data.List (dropWhileEnd)
import Text.Read (readMaybe)

-- https://hackage.haskell.org/package/time
import Data.Time.Clock (NominalDiffTime)

-- ttc
import qualified Data.TTC as TTC

------------------------------------------------------------------------------
-- $Type

-- | A 'Duration' is a measure of seconds.  It is fractional and must be zero
-- or greater.
--
-- The underlying type is 'NominalDiffTime', which may be negative.  The
-- constructor is not exported, and all functions that create a value ensure
-- that the constraint holds.
newtype Duration = Duration NominalDiffTime
  deriving Show

instance TTC.Parse Duration where
  parse = TTC.asS $ \s ->
    maybe (Left $ "invalid Duration: " <> s) fromDouble $ readMaybe s

instance TTC.Render Duration where
  render (Duration t) = TTC.fromS . dropWhileEnd (== 's') $ show t

------------------------------------------------------------------------------
-- $API

-- | Construct a 'Duration' from a 'Double' (seconds).
fromDouble :: Double -> Either String Duration
fromDouble = fromReal

-- | Construct a 'Duration' from a 'Float' (seconds).
fromFloat :: Float -> Either String Duration
fromFloat = fromReal

-- | Construct a 'Duration' from an 'Int' (seconds).
fromInt :: Int -> Either String Duration
fromInt = fromReal

-- | Construct a 'Duration' from an 'Int' (microseconds).
fromMicro :: Int -> Either String Duration
fromMicro us = fromDouble $ fromIntegral us / 1000000.0

-- | Construct a 'Duration' from a 'NominalDiffTime'.
fromNominalDiffTime :: NominalDiffTime -> Either String Duration
fromNominalDiffTime t
    | t >= 0.0 = Right $ Duration t
    | otherwise = Left $ "Duration less than zero: " ++ show t

-- | Construct a 'Duration' from a 'Real' (seconds).
fromReal :: (Real a, Show a) => a -> Either String Duration
fromReal x
    | x >= 0 = Right . Duration $ realToFrac x
    | otherwise = Left $ "Duration less than zero: " ++ show x

-- | Convert a 'Duration' to a 'Double' (seconds).
toDouble :: Duration -> Double
toDouble = toFractional

-- | Convert a 'Duration' to a 'Float' (seconds).
toFloat :: Duration -> Float
toFloat = toFractional

-- | Convert a 'Duration' to a 'Fractional' (seconds).
toFractional :: Fractional a => Duration -> a
toFractional (Duration t) = realToFrac t

-- | Convert a 'Duration' to an 'Int' (seconds).
toInt :: Duration -> Int
toInt = toIntegral

-- | Convert a 'Duration' to an 'Integral' (seconds).
toIntegral :: Integral a => Duration -> a
toIntegral = round . toFloat

-- | Convert a 'Duration' to an 'Int' (microseconds).
toMicro :: Duration -> Int
toMicro (Duration t) = round (realToFrac t * 1000000.0 :: Double)

-- | Convert a 'Duration' to a 'NominalDiffTime'.
toNominalDiffTime :: Duration -> NominalDiffTime
toNominalDiffTime (Duration t) = t

-- | The 'valid' function is created using 'TTC.mkValid' via Template Haskell.
-- Note that 'Duration' does not have a 'Language.Haskell.TH.Syntax.Lift'
-- instance.
$(TTC.mkValid "valid" ''Duration)