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

module Cursor.FuzzyDay
  ( FuzzyDayCursor (..),
    emptyFuzzyDayCursor,
    makeFuzzyDayCursor,
    rebuildFuzzyDayCursorForwards,
    rebuildFuzzyDayCursorBackwards,
    fuzzyDayCursorTextCursorL,
    fuzzyDayCursorGuessForwards,
    fuzzyDayCursorGuessBackwards,
  )
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 FuzzyDayCursor = FuzzyDayCursor
  { FuzzyDayCursor -> TextCursor
fuzzyDayCursorTextCursor :: TextCursor,
    FuzzyDayCursor -> Day
fuzzyDayCursorBaseDay :: Day
  }
  deriving (Int -> FuzzyDayCursor -> ShowS
[FuzzyDayCursor] -> ShowS
FuzzyDayCursor -> String
(Int -> FuzzyDayCursor -> ShowS)
-> (FuzzyDayCursor -> String)
-> ([FuzzyDayCursor] -> ShowS)
-> Show FuzzyDayCursor
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> FuzzyDayCursor -> ShowS
showsPrec :: Int -> FuzzyDayCursor -> ShowS
$cshow :: FuzzyDayCursor -> String
show :: FuzzyDayCursor -> String
$cshowList :: [FuzzyDayCursor] -> ShowS
showList :: [FuzzyDayCursor] -> ShowS
Show, FuzzyDayCursor -> FuzzyDayCursor -> Bool
(FuzzyDayCursor -> FuzzyDayCursor -> Bool)
-> (FuzzyDayCursor -> FuzzyDayCursor -> Bool) -> Eq FuzzyDayCursor
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: FuzzyDayCursor -> FuzzyDayCursor -> Bool
== :: FuzzyDayCursor -> FuzzyDayCursor -> Bool
$c/= :: FuzzyDayCursor -> FuzzyDayCursor -> Bool
/= :: FuzzyDayCursor -> FuzzyDayCursor -> Bool
Eq, (forall x. FuzzyDayCursor -> Rep FuzzyDayCursor x)
-> (forall x. Rep FuzzyDayCursor x -> FuzzyDayCursor)
-> Generic FuzzyDayCursor
forall x. Rep FuzzyDayCursor x -> FuzzyDayCursor
forall x. FuzzyDayCursor -> Rep FuzzyDayCursor x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. FuzzyDayCursor -> Rep FuzzyDayCursor x
from :: forall x. FuzzyDayCursor -> Rep FuzzyDayCursor x
$cto :: forall x. Rep FuzzyDayCursor x -> FuzzyDayCursor
to :: forall x. Rep FuzzyDayCursor x -> FuzzyDayCursor
Generic)

instance Validity FuzzyDayCursor

instance NFData FuzzyDayCursor

emptyFuzzyDayCursor :: Day -> FuzzyDayCursor
emptyFuzzyDayCursor :: Day -> FuzzyDayCursor
emptyFuzzyDayCursor Day
d =
  FuzzyDayCursor
    { fuzzyDayCursorTextCursor :: TextCursor
fuzzyDayCursorTextCursor = TextCursor
emptyTextCursor,
      fuzzyDayCursorBaseDay :: Day
fuzzyDayCursorBaseDay = Day
d
    }

makeFuzzyDayCursor :: Day -> FuzzyDayCursor
makeFuzzyDayCursor :: Day -> FuzzyDayCursor
makeFuzzyDayCursor Day
d =
  FuzzyDayCursor
    { fuzzyDayCursorTextCursor :: TextCursor
fuzzyDayCursorTextCursor =
        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 -> Day -> String
forall t. FormatTime t => TimeLocale -> String -> t -> String
formatTime TimeLocale
defaultTimeLocale String
"%F" Day
d,
      fuzzyDayCursorBaseDay :: Day
fuzzyDayCursorBaseDay = Day
d
    }

rebuildFuzzyDayCursorForwards :: FuzzyDayCursor -> Day
rebuildFuzzyDayCursorForwards :: FuzzyDayCursor -> Day
rebuildFuzzyDayCursorForwards fdc :: FuzzyDayCursor
fdc@FuzzyDayCursor {TextCursor
Day
fuzzyDayCursorTextCursor :: FuzzyDayCursor -> TextCursor
fuzzyDayCursorBaseDay :: FuzzyDayCursor -> Day
fuzzyDayCursorTextCursor :: TextCursor
fuzzyDayCursorBaseDay :: Day
..} =
  Day -> Maybe Day -> Day
forall a. a -> Maybe a -> a
fromMaybe Day
fuzzyDayCursorBaseDay (Maybe Day -> Day) -> Maybe Day -> Day
forall a b. (a -> b) -> a -> b
$ FuzzyDayCursor -> Maybe Day
fuzzyDayCursorGuessForwards FuzzyDayCursor
fdc

rebuildFuzzyDayCursorBackwards :: FuzzyDayCursor -> Day
rebuildFuzzyDayCursorBackwards :: FuzzyDayCursor -> Day
rebuildFuzzyDayCursorBackwards fdc :: FuzzyDayCursor
fdc@FuzzyDayCursor {TextCursor
Day
fuzzyDayCursorTextCursor :: FuzzyDayCursor -> TextCursor
fuzzyDayCursorBaseDay :: FuzzyDayCursor -> Day
fuzzyDayCursorTextCursor :: TextCursor
fuzzyDayCursorBaseDay :: Day
..} =
  Day -> Maybe Day -> Day
forall a. a -> Maybe a -> a
fromMaybe Day
fuzzyDayCursorBaseDay (Maybe Day -> Day) -> Maybe Day -> Day
forall a b. (a -> b) -> a -> b
$ FuzzyDayCursor -> Maybe Day
fuzzyDayCursorGuessBackwards FuzzyDayCursor
fdc

fuzzyDayCursorTextCursorL :: Lens' FuzzyDayCursor TextCursor
fuzzyDayCursorTextCursorL :: Lens' FuzzyDayCursor TextCursor
fuzzyDayCursorTextCursorL =
  (FuzzyDayCursor -> TextCursor)
-> (FuzzyDayCursor -> TextCursor -> FuzzyDayCursor)
-> Lens' FuzzyDayCursor TextCursor
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens FuzzyDayCursor -> TextCursor
fuzzyDayCursorTextCursor ((FuzzyDayCursor -> TextCursor -> FuzzyDayCursor)
 -> Lens' FuzzyDayCursor TextCursor)
-> (FuzzyDayCursor -> TextCursor -> FuzzyDayCursor)
-> Lens' FuzzyDayCursor TextCursor
forall a b. (a -> b) -> a -> b
$ \FuzzyDayCursor
fdc TextCursor
tc ->
    FuzzyDayCursor
fdc {fuzzyDayCursorTextCursor = tc}

fuzzyDayCursorGuessForwards :: FuzzyDayCursor -> Maybe Day
fuzzyDayCursorGuessForwards :: FuzzyDayCursor -> Maybe Day
fuzzyDayCursorGuessForwards FuzzyDayCursor {TextCursor
Day
fuzzyDayCursorTextCursor :: FuzzyDayCursor -> TextCursor
fuzzyDayCursorBaseDay :: FuzzyDayCursor -> Day
fuzzyDayCursorTextCursor :: TextCursor
fuzzyDayCursorBaseDay :: Day
..} = do
  FuzzyDay
fd <- Parsec Void Text FuzzyDay -> Text -> Maybe FuzzyDay
forall e s a. (Ord e, Stream s) => Parsec e s a -> s -> Maybe a
parseMaybe Parsec Void Text FuzzyDay
fuzzyDayP (Text -> Maybe FuzzyDay) -> Text -> Maybe FuzzyDay
forall a b. (a -> b) -> a -> b
$ TextCursor -> Text
rebuildTextCursor TextCursor
fuzzyDayCursorTextCursor
  Day -> FuzzyDay -> Maybe Day
resolveDayForwards Day
fuzzyDayCursorBaseDay FuzzyDay
fd

fuzzyDayCursorGuessBackwards :: FuzzyDayCursor -> Maybe Day
fuzzyDayCursorGuessBackwards :: FuzzyDayCursor -> Maybe Day
fuzzyDayCursorGuessBackwards FuzzyDayCursor {TextCursor
Day
fuzzyDayCursorTextCursor :: FuzzyDayCursor -> TextCursor
fuzzyDayCursorBaseDay :: FuzzyDayCursor -> Day
fuzzyDayCursorTextCursor :: TextCursor
fuzzyDayCursorBaseDay :: Day
..} = do
  FuzzyDay
fd <- Parsec Void Text FuzzyDay -> Text -> Maybe FuzzyDay
forall e s a. (Ord e, Stream s) => Parsec e s a -> s -> Maybe a
parseMaybe Parsec Void Text FuzzyDay
fuzzyDayP (Text -> Maybe FuzzyDay) -> Text -> Maybe FuzzyDay
forall a b. (a -> b) -> a -> b
$ TextCursor -> Text
rebuildTextCursor TextCursor
fuzzyDayCursorTextCursor
  Day -> FuzzyDay -> Maybe Day
resolveDayBackwards Day
fuzzyDayCursorBaseDay FuzzyDay
fd