{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE RecordWildCards #-}

module Cursor.FuzzyTimeOfDay
  ( FuzzyTimeOfDayCursor (..),
    emptyFuzzyTimeOfDayCursor,
    makeFuzzyTimeOfDayCursor,
    rebuildFuzzyTimeOfDayCursorForwards,
    rebuildFuzzyTimeOfDayCursorBackwards,
    fuzzyTimeOfDayCursorTextCursorL,
    fuzzyTimeOfDayCursorGuessForwards,
    fuzzyTimeOfDayCursorGuessBackwards,
  )
where

import Control.DeepSeq
import Cursor.Text
import Data.FuzzyTime
import Data.Maybe
import qualified Data.Text as T
import Data.Time
import Data.Validity
import GHC.Generics (Generic)
import Lens.Micro
import Text.Megaparsec

data FuzzyTimeOfDayCursor = FuzzyTimeOfDayCursor
  { FuzzyTimeOfDayCursor -> TextCursor
fuzzyTimeOfDayCursorTextCursor :: TextCursor,
    FuzzyTimeOfDayCursor -> TimeOfDay
fuzzyTimeOfDayCursorBaseTimeOfDay :: TimeOfDay
  }
  deriving (Int -> FuzzyTimeOfDayCursor -> ShowS
[FuzzyTimeOfDayCursor] -> ShowS
FuzzyTimeOfDayCursor -> String
(Int -> FuzzyTimeOfDayCursor -> ShowS)
-> (FuzzyTimeOfDayCursor -> String)
-> ([FuzzyTimeOfDayCursor] -> ShowS)
-> Show FuzzyTimeOfDayCursor
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> FuzzyTimeOfDayCursor -> ShowS
showsPrec :: Int -> FuzzyTimeOfDayCursor -> ShowS
$cshow :: FuzzyTimeOfDayCursor -> String
show :: FuzzyTimeOfDayCursor -> String
$cshowList :: [FuzzyTimeOfDayCursor] -> ShowS
showList :: [FuzzyTimeOfDayCursor] -> ShowS
Show, FuzzyTimeOfDayCursor -> FuzzyTimeOfDayCursor -> Bool
(FuzzyTimeOfDayCursor -> FuzzyTimeOfDayCursor -> Bool)
-> (FuzzyTimeOfDayCursor -> FuzzyTimeOfDayCursor -> Bool)
-> Eq FuzzyTimeOfDayCursor
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: FuzzyTimeOfDayCursor -> FuzzyTimeOfDayCursor -> Bool
== :: FuzzyTimeOfDayCursor -> FuzzyTimeOfDayCursor -> Bool
$c/= :: FuzzyTimeOfDayCursor -> FuzzyTimeOfDayCursor -> Bool
/= :: FuzzyTimeOfDayCursor -> FuzzyTimeOfDayCursor -> Bool
Eq, (forall x. FuzzyTimeOfDayCursor -> Rep FuzzyTimeOfDayCursor x)
-> (forall x. Rep FuzzyTimeOfDayCursor x -> FuzzyTimeOfDayCursor)
-> Generic FuzzyTimeOfDayCursor
forall x. Rep FuzzyTimeOfDayCursor x -> FuzzyTimeOfDayCursor
forall x. FuzzyTimeOfDayCursor -> Rep FuzzyTimeOfDayCursor x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. FuzzyTimeOfDayCursor -> Rep FuzzyTimeOfDayCursor x
from :: forall x. FuzzyTimeOfDayCursor -> Rep FuzzyTimeOfDayCursor x
$cto :: forall x. Rep FuzzyTimeOfDayCursor x -> FuzzyTimeOfDayCursor
to :: forall x. Rep FuzzyTimeOfDayCursor x -> FuzzyTimeOfDayCursor
Generic)

instance Validity FuzzyTimeOfDayCursor

instance NFData FuzzyTimeOfDayCursor

emptyFuzzyTimeOfDayCursor :: TimeOfDay -> FuzzyTimeOfDayCursor
emptyFuzzyTimeOfDayCursor :: TimeOfDay -> FuzzyTimeOfDayCursor
emptyFuzzyTimeOfDayCursor TimeOfDay
d =
  FuzzyTimeOfDayCursor
    { fuzzyTimeOfDayCursorTextCursor :: TextCursor
fuzzyTimeOfDayCursorTextCursor = TextCursor
emptyTextCursor,
      fuzzyTimeOfDayCursorBaseTimeOfDay :: TimeOfDay
fuzzyTimeOfDayCursorBaseTimeOfDay = TimeOfDay
d
    }

makeFuzzyTimeOfDayCursor :: TimeOfDay -> FuzzyTimeOfDayCursor
makeFuzzyTimeOfDayCursor :: TimeOfDay -> FuzzyTimeOfDayCursor
makeFuzzyTimeOfDayCursor TimeOfDay
d =
  FuzzyTimeOfDayCursor
    { fuzzyTimeOfDayCursorTextCursor :: TextCursor
fuzzyTimeOfDayCursorTextCursor =
        Maybe TextCursor -> TextCursor
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe TextCursor -> TextCursor) -> Maybe TextCursor -> TextCursor
forall a b. (a -> b) -> a -> b
$ Text -> Maybe TextCursor
makeTextCursor (Text -> Maybe TextCursor) -> Text -> Maybe TextCursor
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ TimeLocale -> String -> TimeOfDay -> String
forall t. FormatTime t => TimeLocale -> String -> t -> String
formatTime TimeLocale
defaultTimeLocale String
"%T%Q" TimeOfDay
d,
      fuzzyTimeOfDayCursorBaseTimeOfDay :: TimeOfDay
fuzzyTimeOfDayCursorBaseTimeOfDay = TimeOfDay
d
    }

rebuildFuzzyTimeOfDayCursorForwards :: FuzzyTimeOfDayCursor -> TimeOfDay
rebuildFuzzyTimeOfDayCursorForwards :: FuzzyTimeOfDayCursor -> TimeOfDay
rebuildFuzzyTimeOfDayCursorForwards fdc :: FuzzyTimeOfDayCursor
fdc@FuzzyTimeOfDayCursor {TextCursor
TimeOfDay
fuzzyTimeOfDayCursorTextCursor :: FuzzyTimeOfDayCursor -> TextCursor
fuzzyTimeOfDayCursorBaseTimeOfDay :: FuzzyTimeOfDayCursor -> TimeOfDay
fuzzyTimeOfDayCursorTextCursor :: TextCursor
fuzzyTimeOfDayCursorBaseTimeOfDay :: TimeOfDay
..} =
  TimeOfDay -> Maybe TimeOfDay -> TimeOfDay
forall a. a -> Maybe a -> a
fromMaybe TimeOfDay
fuzzyTimeOfDayCursorBaseTimeOfDay (Maybe TimeOfDay -> TimeOfDay) -> Maybe TimeOfDay -> TimeOfDay
forall a b. (a -> b) -> a -> b
$ FuzzyTimeOfDayCursor -> Maybe TimeOfDay
fuzzyTimeOfDayCursorGuessForwards FuzzyTimeOfDayCursor
fdc

rebuildFuzzyTimeOfDayCursorBackwards :: FuzzyTimeOfDayCursor -> TimeOfDay
rebuildFuzzyTimeOfDayCursorBackwards :: FuzzyTimeOfDayCursor -> TimeOfDay
rebuildFuzzyTimeOfDayCursorBackwards fdc :: FuzzyTimeOfDayCursor
fdc@FuzzyTimeOfDayCursor {TextCursor
TimeOfDay
fuzzyTimeOfDayCursorTextCursor :: FuzzyTimeOfDayCursor -> TextCursor
fuzzyTimeOfDayCursorBaseTimeOfDay :: FuzzyTimeOfDayCursor -> TimeOfDay
fuzzyTimeOfDayCursorTextCursor :: TextCursor
fuzzyTimeOfDayCursorBaseTimeOfDay :: TimeOfDay
..} =
  TimeOfDay -> Maybe TimeOfDay -> TimeOfDay
forall a. a -> Maybe a -> a
fromMaybe TimeOfDay
fuzzyTimeOfDayCursorBaseTimeOfDay (Maybe TimeOfDay -> TimeOfDay) -> Maybe TimeOfDay -> TimeOfDay
forall a b. (a -> b) -> a -> b
$ FuzzyTimeOfDayCursor -> Maybe TimeOfDay
fuzzyTimeOfDayCursorGuessBackwards FuzzyTimeOfDayCursor
fdc

fuzzyTimeOfDayCursorTextCursorL :: Lens' FuzzyTimeOfDayCursor TextCursor
fuzzyTimeOfDayCursorTextCursorL :: Lens' FuzzyTimeOfDayCursor TextCursor
fuzzyTimeOfDayCursorTextCursorL =
  (FuzzyTimeOfDayCursor -> TextCursor)
-> (FuzzyTimeOfDayCursor -> TextCursor -> FuzzyTimeOfDayCursor)
-> Lens' FuzzyTimeOfDayCursor TextCursor
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens FuzzyTimeOfDayCursor -> TextCursor
fuzzyTimeOfDayCursorTextCursor ((FuzzyTimeOfDayCursor -> TextCursor -> FuzzyTimeOfDayCursor)
 -> Lens' FuzzyTimeOfDayCursor TextCursor)
-> (FuzzyTimeOfDayCursor -> TextCursor -> FuzzyTimeOfDayCursor)
-> Lens' FuzzyTimeOfDayCursor TextCursor
forall a b. (a -> b) -> a -> b
$ \FuzzyTimeOfDayCursor
fdc TextCursor
tc -> FuzzyTimeOfDayCursor
fdc {fuzzyTimeOfDayCursorTextCursor = tc}

fuzzyTimeOfDayCursorGuessForwards :: FuzzyTimeOfDayCursor -> Maybe TimeOfDay
fuzzyTimeOfDayCursorGuessForwards :: FuzzyTimeOfDayCursor -> Maybe TimeOfDay
fuzzyTimeOfDayCursorGuessForwards FuzzyTimeOfDayCursor {TextCursor
TimeOfDay
fuzzyTimeOfDayCursorTextCursor :: FuzzyTimeOfDayCursor -> TextCursor
fuzzyTimeOfDayCursorBaseTimeOfDay :: FuzzyTimeOfDayCursor -> TimeOfDay
fuzzyTimeOfDayCursorTextCursor :: TextCursor
fuzzyTimeOfDayCursorBaseTimeOfDay :: TimeOfDay
..} = do
  FuzzyTimeOfDay
ftod <- Parsec Void Text FuzzyTimeOfDay -> Text -> Maybe FuzzyTimeOfDay
forall e s a. (Ord e, Stream s) => Parsec e s a -> s -> Maybe a
parseMaybe Parsec Void Text FuzzyTimeOfDay
fuzzyTimeOfDayP (Text -> Maybe FuzzyTimeOfDay) -> Text -> Maybe FuzzyTimeOfDay
forall a b. (a -> b) -> a -> b
$ TextCursor -> Text
rebuildTextCursor TextCursor
fuzzyTimeOfDayCursorTextCursor
  TimeOfDay -> FuzzyTimeOfDay -> Maybe TimeOfDay
resolveTimeOfDayForwards TimeOfDay
fuzzyTimeOfDayCursorBaseTimeOfDay FuzzyTimeOfDay
ftod

fuzzyTimeOfDayCursorGuessBackwards :: FuzzyTimeOfDayCursor -> Maybe TimeOfDay
fuzzyTimeOfDayCursorGuessBackwards :: FuzzyTimeOfDayCursor -> Maybe TimeOfDay
fuzzyTimeOfDayCursorGuessBackwards FuzzyTimeOfDayCursor {TextCursor
TimeOfDay
fuzzyTimeOfDayCursorTextCursor :: FuzzyTimeOfDayCursor -> TextCursor
fuzzyTimeOfDayCursorBaseTimeOfDay :: FuzzyTimeOfDayCursor -> TimeOfDay
fuzzyTimeOfDayCursorTextCursor :: TextCursor
fuzzyTimeOfDayCursorBaseTimeOfDay :: TimeOfDay
..} = do
  FuzzyTimeOfDay
ftod <- Parsec Void Text FuzzyTimeOfDay -> Text -> Maybe FuzzyTimeOfDay
forall e s a. (Ord e, Stream s) => Parsec e s a -> s -> Maybe a
parseMaybe Parsec Void Text FuzzyTimeOfDay
fuzzyTimeOfDayP (Text -> Maybe FuzzyTimeOfDay) -> Text -> Maybe FuzzyTimeOfDay
forall a b. (a -> b) -> a -> b
$ TextCursor -> Text
rebuildTextCursor TextCursor
fuzzyTimeOfDayCursorTextCursor
  TimeOfDay -> FuzzyTimeOfDay -> Maybe TimeOfDay
resolveTimeOfDayBackwards TimeOfDay
fuzzyTimeOfDayCursorBaseTimeOfDay FuzzyTimeOfDay
ftod