{-# 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