{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE RecordWildCards #-} module Cursor.FuzzyLocalTime ( FuzzyLocalTimeCursor(..) , emptyFuzzyLocalTimeCursor , makeFuzzyLocalTimeCursor , rebuildFuzzyLocalTimeCursor , fuzzyLocalTimeCursorTextCursorL , fuzzyLocalTimeCursorGuess ) 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 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 } rebuildFuzzyLocalTimeCursor :: FuzzyLocalTimeCursor -> AmbiguousLocalTime rebuildFuzzyLocalTimeCursor fdc@FuzzyLocalTimeCursor {..} = fromMaybe (BothTimeAndDay fuzzyLocalTimeCursorBaseLocalTime) $ fuzzyLocalTimeCursorGuess fdc fuzzyLocalTimeCursorTextCursorL :: Lens' FuzzyLocalTimeCursor TextCursor fuzzyLocalTimeCursorTextCursorL = lens fuzzyLocalTimeCursorTextCursor $ \fdc tc -> fdc {fuzzyLocalTimeCursorTextCursor = tc} fuzzyLocalTimeCursorGuess :: FuzzyLocalTimeCursor -> Maybe AmbiguousLocalTime fuzzyLocalTimeCursorGuess FuzzyLocalTimeCursor {..} = do ftod <- parseMaybe fuzzyLocalTimeP $ rebuildTextCursor fuzzyLocalTimeCursorTextCursor pure $ resolveLocalTime fuzzyLocalTimeCursorBaseLocalTime ftod