cursor-fuzzy-time-0.0.0.0: src/Cursor/FuzzyTimeOfDay.hs

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

module Cursor.FuzzyTimeOfDay
  ( FuzzyTimeOfDayCursor(..)
  , emptyFuzzyTimeOfDayCursor
  , makeFuzzyTimeOfDayCursor
  , rebuildFuzzyTimeOfDayCursor
  , fuzzyTimeOfDayCursorTextCursorL
  , fuzzyTimeOfDayCursorGuess
  ) where

import GHC.Generics (Generic)

import Data.Maybe
import qualified Data.Text as T
import Data.Time
import Data.Validity

import Control.DeepSeq

import Text.Megaparsec

import Lens.Micro

import Data.FuzzyTime

import Cursor.Text

data FuzzyTimeOfDayCursor =
  FuzzyTimeOfDayCursor
    { fuzzyTimeOfDayCursorTextCursor :: TextCursor
    , fuzzyTimeOfDayCursorBaseTimeOfDay :: TimeOfDay
    }
  deriving (Show, Eq, Generic)

instance Validity FuzzyTimeOfDayCursor

instance NFData FuzzyTimeOfDayCursor

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

makeFuzzyTimeOfDayCursor :: TimeOfDay -> FuzzyTimeOfDayCursor
makeFuzzyTimeOfDayCursor d =
  FuzzyTimeOfDayCursor
    { fuzzyTimeOfDayCursorTextCursor =
        fromJust $ makeTextCursor $ T.pack $ formatTime defaultTimeLocale "%T%Q" d
    , fuzzyTimeOfDayCursorBaseTimeOfDay = d
    }

rebuildFuzzyTimeOfDayCursor :: FuzzyTimeOfDayCursor -> TimeOfDay
rebuildFuzzyTimeOfDayCursor fdc@FuzzyTimeOfDayCursor {..} =
  fromMaybe fuzzyTimeOfDayCursorBaseTimeOfDay $ fuzzyTimeOfDayCursorGuess fdc

fuzzyTimeOfDayCursorTextCursorL :: Lens' FuzzyTimeOfDayCursor TextCursor
fuzzyTimeOfDayCursorTextCursorL =
  lens fuzzyTimeOfDayCursorTextCursor $ \fdc tc -> fdc {fuzzyTimeOfDayCursorTextCursor = tc}

fuzzyTimeOfDayCursorGuess :: FuzzyTimeOfDayCursor -> Maybe TimeOfDay
fuzzyTimeOfDayCursorGuess FuzzyTimeOfDayCursor {..} = do
  ftod <- parseMaybe fuzzyTimeOfDayP $ rebuildTextCursor fuzzyTimeOfDayCursorTextCursor
  pure $ resolveTimeOfDay fuzzyTimeOfDayCursorBaseTimeOfDay ftod