-- SPDX-FileCopyrightText: 2019 Serokell <https://serokell.io>
--
-- SPDX-License-Identifier: MPL-2.0

{-# LANGUAGE AllowAmbiguousTypes  #-}
{-# LANGUAGE CPP                  #-}
{-# LANGUAGE DataKinds            #-}
{-# LANGUAGE FlexibleContexts     #-}
{-# LANGUAGE FlexibleInstances    #-}
{-# LANGUAGE InstanceSigs         #-}
{-# LANGUAGE Rank2Types           #-}
{-# LANGUAGE TypeOperators        #-}
{-# LANGUAGE UndecidableInstances #-}

-- | This module introduces function to format and parse time in desired way.

module Time.Series
       ( AllTimes
       , type (...)
         -- * Formatting
       , SeriesF (..)
       , unitsF

         -- * Parsing
       , SeriesP (..)
       , unitsP
       ) where

import Data.Char (isDigit, isLetter)
import Data.Kind (Constraint)
import Data.Type.Bool (type (&&), If)
import Data.Type.Equality (type (==))
import GHC.TypeLits (ErrorMessage (Text), TypeError)
import Text.Read (readMaybe)

import Time.Rational (type (>=%), withRuntimeDivRat)
import Time.Rational (Rat)
import Time.Timestamp ((-:-))
import Time.Units (Day, Fortnight, Hour, KnownRatName, Microsecond, Millisecond, Minute, Nanosecond,
                   Picosecond, Second, Time (..), Week, floorUnit, toUnit)

-- $setup
-- >>> import Time.Units (Time (..), fortnight, hour, minute, ms, sec)
-- >>> import Time.Timestamp ((+:+))
-- >>> import GHC.Real ((%))



-- | Type-level list that consist of all times.
type AllTimes =
  '[ Fortnight, Week, Day, Hour, Minute, Second
   , Millisecond , Microsecond, Nanosecond, Picosecond
   ]

{- | Creates the list of time units in descending order by provided
the highest and the lowest bound of the desired list.
Throws the error when time units are not in the right order.

__Usage example:__

>>> seriesF @(Hour ... Second) $ hour 3 +:+ minute 5 +:+ sec 3 +:+ ms 123
"3h5m3+123/1000s"

-}
type family (from :: Rat) ... (to :: Rat) :: [Rat] where
    from ... to = If (IsDescending '[from, to])
                     (TakeWhileNot to (DropWhileNot from AllTimes))
                     (TypeError ('Text "Units should be in descending order"))

-- Drops wile not the required time unit in 'AllTimes'.
type family DropWhileNot (from :: Rat) (units :: [Rat]) :: [Rat] where
    DropWhileNot x '[] = '[]
    DropWhileNot x (u ': units) = If (u == x) (u ': units) (DropWhileNot x units)

-- Takes while not equal to the provided bound.
type family TakeWhileNot (to :: Rat) (units :: [Rat]) :: [Rat] where
    TakeWhileNot x '[] = '[]
    TakeWhileNot x (u ': units) = If (u == x) '[u] (u ': TakeWhileNot x units)

-- | Type family for verification of the descending order of the given
-- list of time units.
type family IsDescending (units :: [Rat]) :: Bool where
    IsDescending ('[])     = 'True
    IsDescending ('[unit]) = 'True
    IsDescending (unit1 ': unit2 ': units) =
        (unit1 >=% unit2) && (IsDescending (unit2 ': units))

type family DescendingConstraint (b :: Bool) :: Constraint where
    DescendingConstraint 'True  = ()  -- empty constraint; always satisfiable
    DescendingConstraint 'False = TypeError ('Text "List of units should be in descending order")

{- | Class for time formatting.

__Examples__

>>> seriesF @'[Day, Hour, Minute, Second] (minute 4000)
"2d18h40m"

>>> seriesF @'[Day, Minute, Second] (minute 4000)
"2d1120m"

>>> seriesF @'[Hour, Minute, Second] (sec 3601)
"1h1s"

>>>  seriesF @'[Hour, Second, Millisecond] (Time @Minute $ 3 % 2)
"90s"

>>> seriesF @'[Hour, Second] (minute 0)
"0h"

>>> seriesF @'[Hour, Minute, Second] (Time @Day (2 % 7))
"6h51m25+5/7s"

The received list should be in descending order. It would be verified at compile-time.
Example of the error from @ghci@:

>>> seriesF @'[Millisecond, Second] (minute 42)
...
    • List of units should be in descending order
    • In the expression: seriesF @'[Millisecond, Second] (minute 42)
      In an equation for ‘it’:
          it = seriesF @'[Millisecond, Second] (minute 42)
...

-}
class SeriesF (units :: [Rat]) where
    seriesF :: forall (someUnit :: Rat) . KnownRatName someUnit
            => Time someUnit
            -> String

instance SeriesF ('[] :: [Rat]) where
    seriesF :: Time someUnit -> String
    seriesF :: Time someUnit -> String
seriesF Time someUnit
_ = String
""

instance (KnownRatName unit) => SeriesF ('[unit] :: [Rat]) where
    seriesF :: forall (someUnit :: Rat) . KnownRatName someUnit
            => Time someUnit -> String
    seriesF :: Time someUnit -> String
seriesF Time someUnit
t =
        let newTime :: Time unit
newTime = forall r.
(KnownRat someUnit, KnownRat unit) =>
(KnownRat (someUnit / unit) => r) -> r
forall (a :: Rat) (b :: Rat) r.
(KnownRat a, KnownRat b) =>
(KnownRat (a / b) => r) -> r
withRuntimeDivRat @someUnit @unit ((KnownRat (someUnit / unit) => Time unit) -> Time unit)
-> (KnownRat (someUnit / unit) => Time unit) -> Time unit
forall a b. (a -> b) -> a -> b
$ Time someUnit -> Time unit
forall (unitTo :: Rat) (unitFrom :: Rat).
KnownDivRat unitFrom unitTo =>
Time unitFrom -> Time unitTo
toUnit @unit Time someUnit
t
        in Time unit -> String
forall a. Show a => a -> String
show Time unit
newTime

instance ( KnownRatName unit
         , SeriesF (nextUnit : units)
         , DescendingConstraint (IsDescending (unit ': nextUnit ': units))
         )
    => SeriesF (unit ': nextUnit ': units :: [Rat]) where
    seriesF :: forall (someUnit :: Rat) . KnownRatName someUnit
            => Time someUnit -> String
    seriesF :: Time someUnit -> String
seriesF Time someUnit
t = let newUnit :: Time unit
newUnit = forall r.
(KnownRat someUnit, KnownRat unit) =>
(KnownRat (someUnit / unit) => r) -> r
forall (a :: Rat) (b :: Rat) r.
(KnownRat a, KnownRat b) =>
(KnownRat (a / b) => r) -> r
withRuntimeDivRat @someUnit @unit ((KnownRat (someUnit / unit) => Time unit) -> Time unit)
-> (KnownRat (someUnit / unit) => Time unit) -> Time unit
forall a b. (a -> b) -> a -> b
$ Time someUnit -> Time unit
forall (unitTo :: Rat) (unitFrom :: Rat).
KnownDivRat unitFrom unitTo =>
Time unitFrom -> Time unitTo
toUnit @unit Time someUnit
t
                    flooredNewUnit :: Time unit
flooredNewUnit = Time unit -> Time unit
forall (unit :: Rat). Time unit -> Time unit
floorUnit Time unit
newUnit
                    timeStr :: String
timeStr = case Time unit
flooredNewUnit of
                                   Time RatioNat
0 -> String
""
                                   Time unit
_      -> Time unit -> String
forall a. Show a => a -> String
show Time unit
flooredNewUnit

                    nextUnit :: Time unit
nextUnit = forall r.
(KnownRat unit, KnownRat unit) =>
(KnownRat (unit / unit) => r) -> r
forall (a :: Rat) (b :: Rat) r.
(KnownRat a, KnownRat b) =>
(KnownRat (a / b) => r) -> r
withRuntimeDivRat @unit @unit ((KnownRat (unit / unit) => Time unit) -> Time unit)
-> (KnownRat (unit / unit) => Time unit) -> Time unit
forall a b. (a -> b) -> a -> b
$ Time unit
newUnit Time unit -> Time unit -> Time unit
forall (unitResult :: Rat) (unitLeft :: Rat).
KnownDivRat unitLeft unitResult =>
Time unitLeft -> Time unitResult -> Time unitResult
-:- Time unit
flooredNewUnit
                in if Time unit
nextUnit Time unit -> Time unit -> Bool
forall a. Eq a => a -> a -> Bool
== RatioNat -> Time unit
forall (rat :: Rat). RatioNat -> Time rat
Time RatioNat
0
                   then Time unit -> String
forall a. Show a => a -> String
show Time unit
newUnit
                   else String
timeStr String -> String -> String
forall a. [a] -> [a] -> [a]
++ Time unit -> String
forall (units :: [Rat]) (someUnit :: Rat).
(SeriesF units, KnownRatName someUnit) =>
Time someUnit -> String
seriesF @(nextUnit ': units) @unit Time unit
nextUnit

{- | Similar to 'seriesF', but formats using all time units of the library.

>>> unitsF $ fortnight 5
"5fn"

>>> unitsF $ minute 4000
"2d18h40m"

-}
unitsF :: forall unit . KnownRatName unit => Time unit -> String
unitsF :: Time unit -> String
unitsF = forall (someUnit :: Rat).
(SeriesF AllTimes, KnownRatName someUnit) =>
Time someUnit -> String
forall (units :: [Rat]) (someUnit :: Rat).
(SeriesF units, KnownRatName someUnit) =>
Time someUnit -> String
seriesF @AllTimes

{- | Class for time parsing.

Empty string on input will be parsed as 0 time of the required time unit:

>>> seriesP @'[Hour, Minute, Second] @Second ""
Just (0s)

__Examples__

>>> seriesP @'[Day, Hour, Minute, Second] @Minute "2d18h40m"
Just (4000m)

>>> seriesP @'[Day, Minute, Second] @Minute "2d1120m"
Just (4000m)

>>> seriesP @'[Hour, Minute, Second] @Second "1h1s"
Just (3601s)

>>> seriesP @'[Hour, Second, Millisecond] @Minute "90s"
Just (1+1/2m)

>>> seriesP @'[Hour, Second] @Second "11ns"
Nothing

>>> seriesP @'[Hour, Minute] @Minute "1+1/2h"
Nothing

>>> seriesP @'[Hour, Minute] @Minute "1+1/2m"
Just (1+1/2m)

>>> seriesP @'[Hour, Minute] @Minute "1h1+1/2m"
Just (61+1/2m)

__Note:__ The received list should be in descending order. It would be verified at compile-time.

-}
class SeriesP (units :: [Rat]) where
    seriesP :: forall (someUnit :: Rat) . KnownRatName someUnit
            => String -> Maybe (Time someUnit)

instance SeriesP '[] where
    seriesP :: String -> Maybe (Time someUnit)
seriesP String
_ = Maybe (Time someUnit)
forall a. Maybe a
Nothing

instance (KnownRatName unit) => SeriesP '[unit] where
    seriesP :: forall (someUnit :: Rat) . KnownRatName someUnit
            => String -> Maybe (Time someUnit)
    seriesP :: String -> Maybe (Time someUnit)
seriesP String
""  = Time someUnit -> Maybe (Time someUnit)
forall a. a -> Maybe a
Just (Time someUnit -> Maybe (Time someUnit))
-> Time someUnit -> Maybe (Time someUnit)
forall a b. (a -> b) -> a -> b
$ RatioNat -> Time someUnit
forall (rat :: Rat). RatioNat -> Time rat
Time RatioNat
0
    seriesP String
str = String -> Maybe (Time someUnit)
forall (unit :: Rat) (someUnit :: Rat).
(KnownRatName unit, KnownRatName someUnit) =>
String -> Maybe (Time someUnit)
readMaybeTime @unit String
str

instance ( KnownRatName unit
         , SeriesP (nextUnit : units)
         , DescendingConstraint (IsDescending (unit ': nextUnit ': units))
         )
         => SeriesP (unit ': nextUnit ': units :: [Rat]) where
    seriesP :: forall (someUnit :: Rat) . KnownRatName someUnit
            => String -> Maybe (Time someUnit)
    seriesP :: String -> Maybe (Time someUnit)
seriesP String
""  = Time someUnit -> Maybe (Time someUnit)
forall a. a -> Maybe a
Just (Time someUnit -> Maybe (Time someUnit))
-> Time someUnit -> Maybe (Time someUnit)
forall a b. (a -> b) -> a -> b
$ RatioNat -> Time someUnit
forall (rat :: Rat). RatioNat -> Time rat
Time RatioNat
0
    seriesP String
str = let (String
num, String
rest)  = (Char -> Bool) -> String -> (String, String)
forall a. (a -> Bool) -> [a] -> ([a], [a])
span Char -> Bool
isDigit String
str
                      (String
u, String
nextStr) = (Char -> Bool) -> String -> (String, String)
forall a. (a -> Bool) -> [a] -> ([a], [a])
span Char -> Bool
isLetter String
rest
                      maybeT :: Maybe (Time someUnit)
maybeT = forall (someUnit :: Rat).
(KnownRatName unit, KnownRatName someUnit) =>
String -> Maybe (Time someUnit)
forall (unit :: Rat) (someUnit :: Rat).
(KnownRatName unit, KnownRatName someUnit) =>
String -> Maybe (Time someUnit)
readMaybeTime @unit (String -> Maybe (Time someUnit))
-> String -> Maybe (Time someUnit)
forall a b. (a -> b) -> a -> b
$ String
num String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
u
                  in case Maybe (Time someUnit)
maybeT of
                         Maybe (Time someUnit)
Nothing -> String -> Maybe (Time someUnit)
forall (units :: [Rat]) (someUnit :: Rat).
(SeriesP units, KnownRatName someUnit) =>
String -> Maybe (Time someUnit)
seriesP @(nextUnit ': units) String
str
                         Just Time someUnit
t  -> ((Time someUnit
t Time someUnit -> Time someUnit -> Time someUnit
forall a. Semigroup a => a -> a -> a
<>)) (Time someUnit -> Time someUnit)
-> Maybe (Time someUnit) -> Maybe (Time someUnit)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (String -> Maybe (Time someUnit)
forall (units :: [Rat]) (someUnit :: Rat).
(SeriesP units, KnownRatName someUnit) =>
String -> Maybe (Time someUnit)
seriesP @(nextUnit ': units) String
nextStr)

{- | Similar to 'seriesP', but parses using all time units of the library.

>>> unitsP @Second "1m"
Just (60s)

>>> unitsP @Minute "2d18h40m"
Just (4000m)

-}
unitsP :: forall unit . KnownRatName unit => String -> Maybe (Time unit)
unitsP :: String -> Maybe (Time unit)
unitsP = KnownRatName unit => String -> Maybe (Time unit)
forall (units :: [Rat]) (someUnit :: Rat).
(SeriesP units, KnownRatName someUnit) =>
String -> Maybe (Time someUnit)
seriesP @AllTimes @unit

----------------------------------------------------------------------------
-- Util
----------------------------------------------------------------------------

readMaybeTime :: forall (unit :: Rat) (someUnit :: Rat) . (KnownRatName unit, KnownRatName someUnit)
              => String -> Maybe (Time someUnit)
readMaybeTime :: String -> Maybe (Time someUnit)
readMaybeTime String
str =
    forall r.
(KnownRat unit, KnownRat someUnit) =>
(KnownRat (unit / someUnit) => r) -> r
forall (a :: Rat) (b :: Rat) r.
(KnownRat a, KnownRat b) =>
(KnownRat (a / b) => r) -> r
withRuntimeDivRat @unit @someUnit ((KnownRat (unit / someUnit) => Maybe (Time someUnit))
 -> Maybe (Time someUnit))
-> (KnownRat (unit / someUnit) => Maybe (Time someUnit))
-> Maybe (Time someUnit)
forall a b. (a -> b) -> a -> b
$
        forall (unitFrom :: Rat).
KnownDivRat unitFrom someUnit =>
Time unitFrom -> Time someUnit
forall (unitTo :: Rat) (unitFrom :: Rat).
KnownDivRat unitFrom unitTo =>
Time unitFrom -> Time unitTo
toUnit @someUnit (Time unit -> Time someUnit)
-> Maybe (Time unit) -> Maybe (Time someUnit)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (String -> Maybe (Time unit)
forall a. Read a => String -> Maybe a
readMaybe @(Time unit) String
str)