content: {-# LANGUAGE DeriveGeneric #-}
  {-# LANGUAGE FlexibleInstances #-}
  {-# LANGUAGE GeneralizedNewtypeDeriving #-}
  {-# LANGUAGE LambdaCase #-}
  {-# LANGUAGE OverloadedStrings #-}
  {-# LANGUAGE RecordWildCards #-}
  {-# LANGUAGE TupleSections #-}
  {-# LANGUAGE TypeApplications #-}
  {-# LANGUAGE ViewPatterns #-}
  {-# LANGUAGE NoImplicitPrelude #-}
  {-# OPTIONS_GHC -fno-warn-orphans #-}
  
  module Data.Time.DateMayTime
    ( -- Date type
      DateMayTime,
      mkDateMayTime,
      getDay,
      -- Date formatting
      dateTimeFormat,
      formatDay,
      formatLocalTime,
      formatDateMayTime,
      -- Date parsing
      parseDateMayTime,
    )
  where
  
  import Data.Aeson
  import Data.Time
    ( Day,
      FormatTime,
      LocalTime (..),
      TimeOfDay,
      defaultTimeLocale,
      formatTime,
      parseTimeM,
    )
  import Relude
  
  -- | Like `Day` but with optional time.
  newtype DateMayTime = DateMayTime {unDateMayTime :: (Day, Maybe TimeOfDay)}
    deriving (Eq, Show, Generic, Ord)
  
  instance ToJSON DateMayTime where
    toJSON = toJSON . formatDateMayTime
  
  instance FromJSON DateMayTime where
    parseJSON = parseDateMayTime <=< parseJSON
  
  mkDateMayTime :: Either Day LocalTime -> DateMayTime
  mkDateMayTime =
    DateMayTime . \case
      Left day ->
        (day, Nothing)
      Right datetime ->
        localDay &&& Just . localTimeOfDay $ datetime
  
  getDay :: DateMayTime -> Day
  getDay = fst . unDateMayTime
  
  formatDateMayTime :: DateMayTime -> Text
  formatDateMayTime (DateMayTime (day, mtime)) =
    maybe (formatDay day) (formatLocalTime . LocalTime day) mtime
  
  formatDay :: Day -> Text
  formatDay = formatTime' dateFormat
  
  formatLocalTime :: LocalTime -> Text
  formatLocalTime = formatTime' dateTimeFormat
  
  parseDateMayTime :: (MonadFail m, Alternative m) => Text -> m DateMayTime
  parseDateMayTime (toString -> s) = do
    fmap mkDateMayTime $
      fmap Left (parseTimeM False defaultTimeLocale dateFormat s)
        <|> fmap Right (parseTimeM False defaultTimeLocale dateTimeFormat s)
  
  dateFormat :: String
  dateFormat = "%Y-%m-%d"
  
  dateTimeFormat :: String
  dateTimeFormat = "%Y-%m-%dT%H:%M"
  
  -- | Like `formatTime` but with default time locale and returning Text
  formatTime' :: FormatTime t => String -> t -> Text
  formatTime' s = toText . formatTime defaultTimeLocale s
  