module Util where

import T4.Data (SimpleLocalTime(SLT))
import Data.List
import Data.Foldable
import Data.Set (Set)
import Data.Map (Map)
import qualified Data.Map as M
import Data.Time

durations :: (Ord a, Show a, Foldable f)
          => (entry -> (Set a, LocalTime))
          -> f entry
          -> Map a NominalDiffTime
durations :: forall a (f :: * -> *) entry.
(Ord a, Show a, Foldable f) =>
(entry -> (Set a, LocalTime)) -> f entry -> Map a NominalDiffTime
durations entry -> (Set a, LocalTime)
extract f entry
xs =
  let entries :: [(Set a, LocalTime)]
entries = ((Set a, LocalTime) -> LocalTime)
-> [(Set a, LocalTime)] -> [(Set a, LocalTime)]
forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn (Set a, LocalTime) -> LocalTime
forall a b. (a, b) -> b
snd ([(Set a, LocalTime)] -> [(Set a, LocalTime)])
-> [(Set a, LocalTime)] -> [(Set a, LocalTime)]
forall a b. (a -> b) -> a -> b
$ entry -> (Set a, LocalTime)
extract (entry -> (Set a, LocalTime)) -> [entry] -> [(Set a, LocalTime)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f entry -> [entry]
forall a. f a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList f entry
xs
      durs :: [Map a NominalDiffTime]
durs    = ((Set a, LocalTime) -> (Set a, LocalTime) -> Map a NominalDiffTime)
-> [(Set a, LocalTime)]
-> [(Set a, LocalTime)]
-> [Map a NominalDiffTime]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (Set a, LocalTime) -> (Set a, LocalTime) -> Map a NominalDiffTime
forall {k} {a}.
(Set k, LocalTime) -> (a, LocalTime) -> Map k NominalDiffTime
pairDur [(Set a, LocalTime)]
entries (Int -> [(Set a, LocalTime)] -> [(Set a, LocalTime)]
forall a. Int -> [a] -> [a]
drop Int
1 [(Set a, LocalTime)]
entries)
  in  (Map a NominalDiffTime
 -> Map a NominalDiffTime -> Map a NominalDiffTime)
-> Map a NominalDiffTime
-> [Map a NominalDiffTime]
-> Map a NominalDiffTime
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr ((NominalDiffTime -> NominalDiffTime -> NominalDiffTime)
-> Map a NominalDiffTime
-> Map a NominalDiffTime
-> Map a NominalDiffTime
forall k a. Ord k => (a -> a -> a) -> Map k a -> Map k a -> Map k a
M.unionWith NominalDiffTime -> NominalDiffTime -> NominalDiffTime
forall a. Num a => a -> a -> a
(+)) Map a NominalDiffTime
forall k a. Map k a
M.empty [Map a NominalDiffTime]
durs
  where pairDur :: (Set k, LocalTime) -> (a, LocalTime) -> Map k NominalDiffTime
pairDur (Set k
ys, LocalTime
t1) (a
_, LocalTime
t2) = (k -> NominalDiffTime) -> Set k -> Map k NominalDiffTime
forall k a. (k -> a) -> Set k -> Map k a
M.fromSet (NominalDiffTime -> k -> NominalDiffTime
forall a b. a -> b -> a
const (NominalDiffTime -> k -> NominalDiffTime)
-> NominalDiffTime -> k -> NominalDiffTime
forall a b. (a -> b) -> a -> b
$ LocalTime -> LocalTime -> NominalDiffTime
diffLocalTime LocalTime
t2 LocalTime
t1) Set k
ys

newtype DurationConfig  = DurConf { DurationConfig -> [DurationUnit]
units :: [DurationUnit] }
                                  deriving (DurationConfig -> DurationConfig -> Bool
(DurationConfig -> DurationConfig -> Bool)
-> (DurationConfig -> DurationConfig -> Bool) -> Eq DurationConfig
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: DurationConfig -> DurationConfig -> Bool
== :: DurationConfig -> DurationConfig -> Bool
$c/= :: DurationConfig -> DurationConfig -> Bool
/= :: DurationConfig -> DurationConfig -> Bool
Eq, Int -> DurationConfig -> ShowS
[DurationConfig] -> ShowS
DurationConfig -> String
(Int -> DurationConfig -> ShowS)
-> (DurationConfig -> String)
-> ([DurationConfig] -> ShowS)
-> Show DurationConfig
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> DurationConfig -> ShowS
showsPrec :: Int -> DurationConfig -> ShowS
$cshow :: DurationConfig -> String
show :: DurationConfig -> String
$cshowList :: [DurationConfig] -> ShowS
showList :: [DurationConfig] -> ShowS
Show)
data    DurationUnit    = DurUnit { DurationUnit -> String
long  :: String
                                  , DurationUnit -> String
short :: String
                                  , DurationUnit -> Integer
size  :: Integer
                                  } deriving (DurationUnit -> DurationUnit -> Bool
(DurationUnit -> DurationUnit -> Bool)
-> (DurationUnit -> DurationUnit -> Bool) -> Eq DurationUnit
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: DurationUnit -> DurationUnit -> Bool
== :: DurationUnit -> DurationUnit -> Bool
$c/= :: DurationUnit -> DurationUnit -> Bool
/= :: DurationUnit -> DurationUnit -> Bool
Eq, Int -> DurationUnit -> ShowS
[DurationUnit] -> ShowS
DurationUnit -> String
(Int -> DurationUnit -> ShowS)
-> (DurationUnit -> String)
-> ([DurationUnit] -> ShowS)
-> Show DurationUnit
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> DurationUnit -> ShowS
showsPrec :: Int -> DurationUnit -> ShowS
$cshow :: DurationUnit -> String
show :: DurationUnit -> String
$cshowList :: [DurationUnit] -> ShowS
showList :: [DurationUnit] -> ShowS
Show)

naturalDurationConfig :: DurationConfig
naturalDurationConfig :: DurationConfig
naturalDurationConfig = [DurationUnit] -> DurationConfig
DurConf
  [ String -> String -> Integer -> DurationUnit
DurUnit String
"seconds" String
"s"   Integer
60
  , String -> String -> Integer -> DurationUnit
DurUnit String
"minutes" String
"mi"  Integer
60
  , String -> String -> Integer -> DurationUnit
DurUnit String
"hours"   String
"h"   Integer
24
  , String -> String -> Integer -> DurationUnit
DurUnit String
"days"    String
"d"   Integer
30
  , String -> String -> Integer -> DurationUnit
DurUnit String
"months"  String
"mo"  Integer
12
  , String -> String -> Integer -> DurationUnit
DurUnit String
"years"   String
"y"   (Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int
forall a. Bounded a => a
maxBound :: Int))
  ]

manDurationConfig :: DurationConfig
manDurationConfig :: DurationConfig
manDurationConfig = [DurationUnit] -> DurationConfig
DurConf
  [ String -> String -> Integer -> DurationUnit
DurUnit String
"seconds"     String
"s"   Integer
60
  , String -> String -> Integer -> DurationUnit
DurUnit String
"minutes"     String
"mi"  Integer
60
  , String -> String -> Integer -> DurationUnit
DurUnit String
"hours"       String
"h"   Integer
8
  , String -> String -> Integer -> DurationUnit
DurUnit String
"man-days"    String
"d"   Integer
20
  , String -> String -> Integer -> DurationUnit
DurUnit String
"man-months"  String
"mo"  Integer
12
  , String -> String -> Integer -> DurationUnit
DurUnit String
"years"       String
"y"   (Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int
forall a. Bounded a => a
maxBound :: Int))
  ]

maxDuration :: DurationConfig -> NominalDiffTime
maxDuration :: DurationConfig -> NominalDiffTime
maxDuration = Pico -> NominalDiffTime
secondsToNominalDiffTime (Pico -> NominalDiffTime)
-> (DurationConfig -> Pico) -> DurationConfig -> NominalDiffTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Pico
forall a b. (Integral a, Num b) => a -> b
fromIntegral
            (Integer -> Pico)
-> (DurationConfig -> Integer) -> DurationConfig -> Pico
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Integer
forall a. Enum a => a -> a
pred (Integer -> Integer)
-> (DurationConfig -> Integer) -> DurationConfig -> Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Integer] -> Integer
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
product ([Integer] -> Integer)
-> (DurationConfig -> [Integer]) -> DurationConfig -> Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (DurationUnit -> Integer) -> [DurationUnit] -> [Integer]
forall a b. (a -> b) -> [a] -> [b]
map DurationUnit -> Integer
size ([DurationUnit] -> [Integer])
-> (DurationConfig -> [DurationUnit])
-> DurationConfig
-> [Integer]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DurationConfig -> [DurationUnit]
units

splitDiffTime :: DurationConfig -> NominalDiffTime -> [(Integer, DurationUnit)]
splitDiffTime :: DurationConfig -> NominalDiffTime -> [(Integer, DurationUnit)]
splitDiffTime DurationConfig
dc NominalDiffTime
time = ([(Integer, DurationUnit)], Integer) -> [(Integer, DurationUnit)]
forall a b. (a, b) -> a
fst (([(Integer, DurationUnit)], Integer) -> [(Integer, DurationUnit)])
-> ([(Integer, DurationUnit)], Integer)
-> [(Integer, DurationUnit)]
forall a b. (a -> b) -> a -> b
$ (([(Integer, DurationUnit)], Integer)
 -> DurationUnit -> ([(Integer, DurationUnit)], Integer))
-> ([(Integer, DurationUnit)], Integer)
-> [DurationUnit]
-> ([(Integer, DurationUnit)], Integer)
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl ([(Integer, DurationUnit)], Integer)
-> DurationUnit -> ([(Integer, DurationUnit)], Integer)
step ([], NominalDiffTime -> Integer
forall b. Integral b => NominalDiffTime -> b
forall a b. (RealFrac a, Integral b) => a -> b
floor NominalDiffTime
time) (DurationConfig -> [DurationUnit]
units DurationConfig
dc)
  where step :: ([(Integer, DurationUnit)], Integer)
-> DurationUnit -> ([(Integer, DurationUnit)], Integer)
step ([(Integer, DurationUnit)]
xs, Integer
i) du :: DurationUnit
du@(DurUnit String
_ String
_ Integer
s) =
          let (Integer
q, Integer
r) = Integer
i Integer -> Integer -> (Integer, Integer)
forall a. Integral a => a -> a -> (a, a)
`quotRem` Integer
s
          in  ((Integer
r,DurationUnit
du)(Integer, DurationUnit)
-> [(Integer, DurationUnit)] -> [(Integer, DurationUnit)]
forall a. a -> [a] -> [a]
:[(Integer, DurationUnit)]
xs, Integer
q)

showDiffTimeSplits :: [(Integer, DurationUnit)] -> String
showDiffTimeSplits :: [(Integer, DurationUnit)] -> String
showDiffTimeSplits = [String] -> String
unwords ([String] -> String)
-> ([(Integer, DurationUnit)] -> [String])
-> [(Integer, DurationUnit)]
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Integer, DurationUnit) -> String)
-> [(Integer, DurationUnit)] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (Integer, DurationUnit) -> String
forall {a}. Show a => (a, DurationUnit) -> String
showPair ([(Integer, DurationUnit)] -> [String])
-> ([(Integer, DurationUnit)] -> [(Integer, DurationUnit)])
-> [(Integer, DurationUnit)]
-> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Integer, DurationUnit)] -> [(Integer, DurationUnit)]
forall {b}. [(Integer, b)] -> [(Integer, b)]
onlySignificant
  where onlySignificant :: [(Integer, b)] -> [(Integer, b)]
onlySignificant   = ((Integer, b) -> Bool) -> [(Integer, b)] -> [(Integer, b)]
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (((Integer, b) -> Bool) -> [(Integer, b)] -> [(Integer, b)])
-> ((Integer, b) -> Bool) -> [(Integer, b)] -> [(Integer, b)]
forall a b. (a -> b) -> a -> b
$ (Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
0) (Integer -> Bool)
-> ((Integer, b) -> Integer) -> (Integer, b) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Integer, b) -> Integer
forall a b. (a, b) -> a
fst
        showPair :: (a, DurationUnit) -> String
showPair (a
i, DurationUnit
du)  = a -> String
forall a. Show a => a -> String
show a
i String -> ShowS
forall a. [a] -> [a] -> [a]
++ DurationUnit -> String
short DurationUnit
du

showDiffTime :: DurationConfig -> NominalDiffTime -> String
showDiffTime :: DurationConfig -> NominalDiffTime -> String
showDiffTime DurationConfig
dc = [(Integer, DurationUnit)] -> String
showDiffTimeSplits ([(Integer, DurationUnit)] -> String)
-> (NominalDiffTime -> [(Integer, DurationUnit)])
-> NominalDiffTime
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DurationConfig -> NominalDiffTime -> [(Integer, DurationUnit)]
splitDiffTime DurationConfig
dc

showRoughDiffTime :: DurationConfig -> NominalDiffTime -> String
showRoughDiffTime :: DurationConfig -> NominalDiffTime -> String
showRoughDiffTime DurationConfig
dc = [(Integer, DurationUnit)] -> String
showDiffTimeSplits ([(Integer, DurationUnit)] -> String)
-> (NominalDiffTime -> [(Integer, DurationUnit)])
-> NominalDiffTime
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Integer, DurationUnit)] -> [(Integer, DurationUnit)]
forall a. HasCallStack => [a] -> [a]
init ([(Integer, DurationUnit)] -> [(Integer, DurationUnit)])
-> (NominalDiffTime -> [(Integer, DurationUnit)])
-> NominalDiffTime
-> [(Integer, DurationUnit)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DurationConfig -> NominalDiffTime -> [(Integer, DurationUnit)]
splitDiffTime DurationConfig
dc

getCurrentSLT :: IO SimpleLocalTime
getCurrentSLT :: IO SimpleLocalTime
getCurrentSLT = LocalTime -> SimpleLocalTime
SLT (LocalTime -> SimpleLocalTime)
-> (ZonedTime -> LocalTime) -> ZonedTime -> SimpleLocalTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ZonedTime -> LocalTime
zonedTimeToLocalTime (ZonedTime -> SimpleLocalTime)
-> IO ZonedTime -> IO SimpleLocalTime
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO ZonedTime
getZonedTime