{-# OPTIONS_GHC -Wall #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE TemplateHaskell #-}

module Data.Aviation.Casr.Logbook.Types.TimeAmount(
  TimeAmount(..)
, HasTimeAmount(..)
, parttimeamount
, zerotimeamount
, addtimeamount
, timeAmountBy10
) where

import Data.Semigroup(Semigroup((<>)))
import Control.Lens(makeClassy, ( # ))
import Data.Eq(Eq)
import Data.Digit(DecDigit, x0, integralDecimal, addDecDigit')
import Data.Int(Int)
import Data.Monoid(Monoid(mempty, mappend))
import Data.Ord(Ord)
import Prelude(Show, Num((+), (*)))

data TimeAmount =
  TimeAmount {
    TimeAmount -> Int
_hours :: Int
  , TimeAmount -> DecDigit
_tenthofhour :: DecDigit
  } deriving (TimeAmount -> TimeAmount -> Bool
(TimeAmount -> TimeAmount -> Bool)
-> (TimeAmount -> TimeAmount -> Bool) -> Eq TimeAmount
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TimeAmount -> TimeAmount -> Bool
== :: TimeAmount -> TimeAmount -> Bool
$c/= :: TimeAmount -> TimeAmount -> Bool
/= :: TimeAmount -> TimeAmount -> Bool
Eq, Eq TimeAmount
Eq TimeAmount =>
(TimeAmount -> TimeAmount -> Ordering)
-> (TimeAmount -> TimeAmount -> Bool)
-> (TimeAmount -> TimeAmount -> Bool)
-> (TimeAmount -> TimeAmount -> Bool)
-> (TimeAmount -> TimeAmount -> Bool)
-> (TimeAmount -> TimeAmount -> TimeAmount)
-> (TimeAmount -> TimeAmount -> TimeAmount)
-> Ord TimeAmount
TimeAmount -> TimeAmount -> Bool
TimeAmount -> TimeAmount -> Ordering
TimeAmount -> TimeAmount -> TimeAmount
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: TimeAmount -> TimeAmount -> Ordering
compare :: TimeAmount -> TimeAmount -> Ordering
$c< :: TimeAmount -> TimeAmount -> Bool
< :: TimeAmount -> TimeAmount -> Bool
$c<= :: TimeAmount -> TimeAmount -> Bool
<= :: TimeAmount -> TimeAmount -> Bool
$c> :: TimeAmount -> TimeAmount -> Bool
> :: TimeAmount -> TimeAmount -> Bool
$c>= :: TimeAmount -> TimeAmount -> Bool
>= :: TimeAmount -> TimeAmount -> Bool
$cmax :: TimeAmount -> TimeAmount -> TimeAmount
max :: TimeAmount -> TimeAmount -> TimeAmount
$cmin :: TimeAmount -> TimeAmount -> TimeAmount
min :: TimeAmount -> TimeAmount -> TimeAmount
Ord, Int -> TimeAmount -> ShowS
[TimeAmount] -> ShowS
TimeAmount -> String
(Int -> TimeAmount -> ShowS)
-> (TimeAmount -> String)
-> ([TimeAmount] -> ShowS)
-> Show TimeAmount
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TimeAmount -> ShowS
showsPrec :: Int -> TimeAmount -> ShowS
$cshow :: TimeAmount -> String
show :: TimeAmount -> String
$cshowList :: [TimeAmount] -> ShowS
showList :: [TimeAmount] -> ShowS
Show)

makeClassy ''TimeAmount

parttimeamount ::
  DecDigit
  -> TimeAmount
parttimeamount :: DecDigit -> TimeAmount
parttimeamount =
  Int -> DecDigit -> TimeAmount
TimeAmount Int
0

zerotimeamount ::
  TimeAmount
zerotimeamount :: TimeAmount
zerotimeamount =
  Int -> DecDigit -> TimeAmount
TimeAmount Int
0 DecDigit
forall d. D0 d => d
x0

addtimeamount ::
  TimeAmount
  -> TimeAmount
  -> TimeAmount
TimeAmount Int
f1 DecDigit
p1 addtimeamount :: TimeAmount -> TimeAmount -> TimeAmount
`addtimeamount` TimeAmount Int
f2 DecDigit
p2 =
  let (DecDigit
h, DecDigit
q) = DecDigit
p1 DecDigit -> DecDigit -> (DecDigit, DecDigit)
`addDecDigit'` DecDigit
p2
  in  Int -> DecDigit -> TimeAmount
TimeAmount (Int
f1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
f2 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Tagged DecDigit (Identity DecDigit) -> Tagged Int (Identity Int)
forall a d. (Integral a, Decimal d) => Prism' a d
Prism' Int DecDigit
integralDecimal (Tagged DecDigit (Identity DecDigit) -> Tagged Int (Identity Int))
-> DecDigit -> Int
forall t b. AReview t b -> b -> t
# (DecDigit
h :: DecDigit)) DecDigit
q

timeAmountBy10 ::
  TimeAmount
  -> Int
timeAmountBy10 :: TimeAmount -> Int
timeAmountBy10 (TimeAmount Int
a DecDigit
b) =
  Int
a Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
10 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Tagged DecDigit (Identity DecDigit) -> Tagged Int (Identity Int)
forall a d. (Integral a, Decimal d) => Prism' a d
Prism' Int DecDigit
integralDecimal (Tagged DecDigit (Identity DecDigit) -> Tagged Int (Identity Int))
-> DecDigit -> Int
forall t b. AReview t b -> b -> t
# DecDigit
b

instance Semigroup TimeAmount where
  <> :: TimeAmount -> TimeAmount -> TimeAmount
(<>) =
    TimeAmount -> TimeAmount -> TimeAmount
addtimeamount

instance Monoid TimeAmount where
  mempty :: TimeAmount
mempty =
    TimeAmount
zerotimeamount
  mappend :: TimeAmount -> TimeAmount -> TimeAmount
mappend =
    TimeAmount -> TimeAmount -> TimeAmount
forall a. Semigroup a => a -> a -> a
(<>)