FuzzyLocalTime.hs

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

module Cursor.FuzzyLocalTime
  ( FuzzyLocalTimeCursor (..),
    emptyFuzzyLocalTimeCursor,
    makeFuzzyLocalTimeCursor,
    rebuildFuzzyLocalTimeCursorForwards,
    rebuildFuzzyLocalTimeCursorBackwards,
    fuzzyLocalTimeCursorTextCursorL,
    fuzzyLocalTimeCursorGuessForwards,
    fuzzyLocalTimeCursorGuessBackwards,
  )
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 FuzzyLocalTimeCursor = FuzzyLocalTimeCursor
  { fuzzyLocalTimeCursorTextCursor :: TextCursor,
    fuzzyLocalTimeCursorBaseLocalTime :: LocalTime
  }
  deriving (Show, Eq, Generic)

instance Validity FuzzyLocalTimeCursor

instance NFData FuzzyLocalTimeCursor

emptyFuzzyLocalTimeCursor :: LocalTime -> FuzzyLocalTimeCursor
emptyFuzzyLocalTimeCursor d =
  FuzzyLocalTimeCursor
    { fuzzyLocalTimeCursorTextCursor = emptyTextCursor,
      fuzzyLocalTimeCursorBaseLocalTime = d
    }

makeFuzzyLocalTimeCursor :: AmbiguousLocalTime -> FuzzyLocalTimeCursor
makeFuzzyLocalTimeCursor alt =
  FuzzyLocalTimeCursor
    { fuzzyLocalTimeCursorTextCursor =
        fromJust $
          makeTextCursor $
            T.pack $
              case alt of
                OnlyDaySpecified d -> formatTime defaultTimeLocale "%F" d
                BothTimeAndDay lt -> formatTime defaultTimeLocale "%F %T%Q" lt,
      fuzzyLocalTimeCursorBaseLocalTime =
        case alt of
          OnlyDaySpecified d -> LocalTime d midnight
          BothTimeAndDay lt -> lt
    }

rebuildFuzzyLocalTimeCursorForwards :: FuzzyLocalTimeCursor -> AmbiguousLocalTime
rebuildFuzzyLocalTimeCursorForwards fdc@FuzzyLocalTimeCursor {..} =
  fromMaybe (BothTimeAndDay fuzzyLocalTimeCursorBaseLocalTime) $ fuzzyLocalTimeCursorGuessForwards fdc

rebuildFuzzyLocalTimeCursorBackwards :: FuzzyLocalTimeCursor -> AmbiguousLocalTime
rebuildFuzzyLocalTimeCursorBackwards fdc@FuzzyLocalTimeCursor {..} =
  fromMaybe (BothTimeAndDay fuzzyLocalTimeCursorBaseLocalTime) $ fuzzyLocalTimeCursorGuessBackwards fdc

fuzzyLocalTimeCursorTextCursorL :: Lens' FuzzyLocalTimeCursor TextCursor
fuzzyLocalTimeCursorTextCursorL =
  lens fuzzyLocalTimeCursorTextCursor $ \fdc tc -> fdc {fuzzyLocalTimeCursorTextCursor = tc}

fuzzyLocalTimeCursorGuessForwards :: FuzzyLocalTimeCursor -> Maybe AmbiguousLocalTime
fuzzyLocalTimeCursorGuessForwards FuzzyLocalTimeCursor {..} = do
  ftod <- parseMaybe fuzzyLocalTimeP $ rebuildTextCursor fuzzyLocalTimeCursorTextCursor
  resolveLocalTimeForwards fuzzyLocalTimeCursorBaseLocalTime ftod

fuzzyLocalTimeCursorGuessBackwards :: FuzzyLocalTimeCursor -> Maybe AmbiguousLocalTime
fuzzyLocalTimeCursorGuessBackwards FuzzyLocalTimeCursor {..} = do
  ftod <- parseMaybe fuzzyLocalTimeP $ rebuildTextCursor fuzzyLocalTimeCursorTextCursor
  resolveLocalTimeBackwards fuzzyLocalTimeCursorBaseLocalTime ftod