dclock in haskell

If you have followed my x64 assembly implementation you would know that I use the concept of time in 1000 decimal minutes per a day. so i wrote a relatively simple version in haskell to explore the machines packagE and really just have fun with haskell. I’ll cover the basic implementation of it rather quickly to show the basic usage of machines and other features that I decided to completely over engineer…maybe.

What are some things we did in dclock?

use machines package to create a monadic pipeline
create newtypes to emphasize type safety and help with abstraction
use data.text instead of strings (better performance)
use point free function composition
utilize inline preprocessor to inline functions that could potentially have better performance than call overhead.
work on separation of concerns by creating functions for specific purposes
Tests above calculation functions
runtime validation of decimaltime calculation

We decompose the problem “convert our system time to decimal time” and compose smaller, type safe, reusable and testable functions to solve our problem. how we do that is unique to the individual and what is seen fit for the problem at hand. We can abstract too much, or as i believe to little and make the composed functions slightly more difficult to comprehend than if we were to leave the composed functions close to the concrete types and expressions. So lets start with understanding our formula for conversion.

Converting elapsed time to decimal

We have the following formula to implement:

$D = \left\lfloor 1000 - \left( 1000 \times \frac{H \times 3600 + M \times 60 + S}{86400} \right) \right\rfloor$

This formula is rather simple, there is 24 * 60 minutes * 60 seconds = 86,400 seconds in a day. Next we take the Hours, minutes and seconds (converting hours and minutes to seconds) and adding them together to get the seconds elapsed since midnight.When we divide the result of elapsed time by the seconds in a day we will receive the fraction of the day.Then we must scale that to our 1,000 decimal minutes by dividing it by 1000. We lastly subtract it to invert the count to count down instead of up. So now we have midnight being we get our new 1,000 decimal minutes.

We did create 4 new types that allow us to abstract away from concrete types so we are able to understand when we are working with seconds, fractions of a day, deicmal time and a valid decimal time.

-- | Decimal time types
newtype Seconds = Seconds Double
  deriving (Eq, Ord, Num, Fractional, Real, RealFrac)

newtype Days = Days Double
  deriving (Eq, Ord, Num, Fractional, Real, RealFrac)

newtype DecimalTime = DecimalTime Int
  deriving (Eq, Show, Ord, Num, Enum, Real, Integral)

-- | Validation for our decimal time values
newtype ValidDecimalTime = ValidDecimalTime
  {unVDT :: DecimalTime}
  deriving (Show, Eq)

Now we can use our new types to work with the conversion and output from the systems monotonic clock time to decimaltime. We added in a ValidDecimalTime with an accessor that allows us to deconstruct a ValidDecimaltime to a decimaltime type, which you will later see why we did this as we look at the validation function.

you may be asking Why so much abstraction for a small calculation? we strive to create software that is well engineered, performs as it should, without error or side effects. when we abstract from concrete types to our newtypes we create a stricter interface for our types and we get compile time guarantee of our types. it helps us understand what our calculation is returning so we know what the integer value is representing.

-- | Pure functions used to calculate the decimal time from Data.Time.getZonedTime
--
-- prop> sec (TimeOfDay 0 0 0) == 0.0 
-- prop> sec (TimeOfDay 1 0 0) == 3600.0 
-- prop> sec (TimeOfDay 24 0 0) == 86400.0
{-# INLINE sec #-}
sec :: TimeOfDay -> Seconds
sec (TimeOfDay !h !m !s) = ((*3600) h' + (*60) m') + s'
  where
    h' = fromIntegral h
    m' = fromIntegral m
    s' = realToFrac s

-- | Get fraction of the day
--
-- prop> frac (TimeOfDay 0 0 0) == 0.0
-- prop> frac (TimeOfDay 12 0 0) == 0.5
{-# INLINE frac #-}
frac :: TimeOfDay -> Days
frac = Days . (/ secd) . (\(Seconds s) -> s) . sec
  where
    secd = 24 * 60 * 60
    {-# INLINE secd #-}
    
-- | Validate the DecimalTime calculated
{-# INLINEABLE mkVDT #-}
mkVDT :: DecimalTime -> Either String ValidDecimalTime
mkVDT dt@(DecimalTime t)
  | t >= 0 && t <= 1000 = Right $ ValidDecimalTime dt
  | otherwise = Left "Time must be between 0 and 1000"

-- | Convert fraction of day to decimal time
--
-- prop> dec (TimeOfDay 0 0 0) == 1000
-- prop> dec (TimeOfDay 12 0 0) == 500
-- prop> dec (TimeOfDay 16 0 0) == 333
{-# INLINE dec #-}
dec :: TimeOfDay -> Either String ValidDecimalTime
dec = mkVDT . DecimalTime . d
  where
    d = round . (1000 -) . (* 1000) . frac
    {-# INLINE d #-}

note on the code: I personally like point free style which in just like mathematics where functions compose right to left. “mkVDT ‘after’ decimaltime ‘after’ d”

The heart of the above snippet is really in dec where we take a timeofday, send it to frac which sends it to sec and converts the time to elapsed seconds since midnight, returns back seconds we unwrap the seconds so we can calculate the fraction of the day by dividing it with seconds of the day and wrapping that result in Days. This returns back to frac where we wrap it in days and return back to dec finally. we scale it to our 1000 decimal minues by multiplying our retuRN of fraction of a day and then getting the inverse by subtracting it so we essentially count down. We wrap it in a decimaltime and pass it off to validate the decimaltime by sending it to mkvdt. which makes sure the calculation is within the bounds of our formula.

-- | Transform zoned time to local time
loc :: ZonedTime -> TimeOfDay
loc = localTimeOfDay . zonedTimeToLocalTime

-- | Retrieve initial time and create our process (producer)
zone :: ProcessT IO k ZonedTime
zone = construct $ do
  zt <- liftIO getZonedTime
  yield zt

-- | Format the output of the validation
--
-- prop> fmt (Right $ ValidDecimalTime (DecimalTime 1000)) == "Decimal time: NEW"
-- prop> fmt (Right $ ValidDecimalTime (DecimalTime 500)) == "Decimal time: 500"
-- prop> fmt (Right $ ValidDecimalTime (DecimalTime 333)) == "Decimal time: 333"
-- prop> fmt (Left "Time must be between 0 and 1000") == "Decimal time: Time must be between 0 and 1000"
{-# INLINE fmt #-}
fmt :: Either String ValidDecimalTime -> T.Text
fmt = ("Decimal time: " <>) . either T.pack (fd . unVDT)
  where
    fd = \case
      DecimalTime 1000 -> "NEW"
      DecimalTime t -> T.pack . show $ t

-- | Output the valid decimal time (consumer)
result :: ProcessT IO T.Text ()
result = construct $ await >>= liftIO . TIO.putStrLn

main :: IO ()
main =
  runT_ $
    zone
      ~> mapping loc
      ~> mapping dec
      ~> mapping fmt
      ~> result

Note on the following code: in fmt we are receiving in a validdecimaltime which is either an error or a valid decimaltime value. so we use the accessor from or validdecimaltime type to unwrap it and either “right” which would be a valid time and we unwrap the decimaltime to print either “NEW” for midnight or the current decimal time. if it was an error we will print our error “time must be between 0 and 1000” finally the last process takes the T.Text to display and outputs it to the screen.

MAIN IS THE SIMPLEST that runt_ runs our process in the io monad discarding any final results and we utilize mapping which is essentially (autom . return) lifting our pure functions into the process.

full source code can be found in the dclock repo on my personal github here