content: -- 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 _ = ""
  
  instance (KnownRatName unit) => SeriesF ('[unit] :: [Rat]) where
      seriesF :: forall (someUnit :: Rat) . KnownRatName someUnit
              => Time someUnit -> String
      seriesF t =
          let newTime = withRuntimeDivRat @someUnit @unit $ toUnit @unit t
          in show 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 t = let newUnit = withRuntimeDivRat @someUnit @unit $ toUnit @unit t
                      flooredNewUnit = floorUnit newUnit
                      timeStr = case flooredNewUnit of
                                     Time 0 -> ""
                                     _      -> show flooredNewUnit
  
                      nextUnit = withRuntimeDivRat @unit @unit $ newUnit -:- flooredNewUnit
                  in if nextUnit == Time 0
                     then show newUnit
                     else timeStr ++ seriesF @(nextUnit ': units) @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 = 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 _ = Nothing
  
  instance (KnownRatName unit) => SeriesP '[unit] where
      seriesP :: forall (someUnit :: Rat) . KnownRatName someUnit
              => String -> Maybe (Time someUnit)
      seriesP ""  = Just $ Time 0
      seriesP str = readMaybeTime @unit 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 ""  = Just $ Time 0
      seriesP str = let (num, rest)  = span isDigit str
                        (u, nextStr) = span isLetter rest
                        maybeT = readMaybeTime @unit $ num ++ u
                    in case maybeT of
                           Nothing -> seriesP @(nextUnit ': units) str
                           Just t  -> ((t <>)) <$> (seriesP @(nextUnit ': units) 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 = seriesP @AllTimes @unit
  
  ----------------------------------------------------------------------------
  -- Util
  ----------------------------------------------------------------------------
  
  readMaybeTime :: forall (unit :: Rat) (someUnit :: Rat) . (KnownRatName unit, KnownRatName someUnit)
                => String -> Maybe (Time someUnit)
  readMaybeTime str =
      withRuntimeDivRat @unit @someUnit $
          toUnit @someUnit <$> (readMaybe @(Time unit) str)
  