-- |
--
-- Copyright:
--   This file is part of the package themoviedb.  It is subject to
--   the license terms in the LICENSE file found in the top-level
--   directory of this distribution and at:
--
--     https://github.com/pjones/themoviedb
--
--   No part of this package, including this file, may be copied,
--   modified, propagated, or distributed except according to the terms
--   contained in the LICENSE file.
--
-- License: MIT
--
-- Utility type for working with release dates.
module Network.API.TheMovieDB.Internal.Date
  ( Date (..),
    parseDay,
    (.::),
  )
where

import Data.Aeson
import Data.Aeson.Types (Parser, typeMismatch)
import qualified Data.Text as Text
import Data.Time (Day (..), parseTimeM)
import Data.Time.Format (defaultTimeLocale)

-- | A simple type wrapper around 'Day' in order to parse a movie's
-- release date, which may be null or empty.
newtype Date = Date {Date -> Maybe Day
day :: Maybe Day} deriving (Date -> Date -> Bool
(Date -> Date -> Bool) -> (Date -> Date -> Bool) -> Eq Date
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Date -> Date -> Bool
$c/= :: Date -> Date -> Bool
== :: Date -> Date -> Bool
$c== :: Date -> Date -> Bool
Eq, Int -> Date -> ShowS
[Date] -> ShowS
Date -> String
(Int -> Date -> ShowS)
-> (Date -> String) -> ([Date] -> ShowS) -> Show Date
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Date] -> ShowS
$cshowList :: [Date] -> ShowS
show :: Date -> String
$cshow :: Date -> String
showsPrec :: Int -> Date -> ShowS
$cshowsPrec :: Int -> Date -> ShowS
Show)

-- | Aeson helper function to parse dates in TheMovieDB API.
parseDay :: Object -> Text -> Parser (Maybe Day)
parseDay :: Object -> Text -> Parser (Maybe Day)
parseDay Object
v Text
key = do
  Maybe Date
m <- Parser (Maybe Date)
date
  Maybe Day -> Parser (Maybe Day)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Date
m Maybe Date -> (Date -> Maybe Day) -> Maybe Day
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Date -> Maybe Day
day)
  where
    date :: Parser (Maybe Date)
    date :: Parser (Maybe Date)
date = Object
v Object -> Text -> Parser (Maybe Date)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
key Parser (Maybe Date) -> Parser (Maybe Date) -> Parser (Maybe Date)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe Date -> Parser (Maybe Date)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe Date
forall a. Maybe a
Nothing

-- | Infix alias for 'parseDay'.
(.::) :: Object -> Text -> Parser (Maybe Day)
.:: :: Object -> Text -> Parser (Maybe Day)
(.::) = Object -> Text -> Parser (Maybe Day)
parseDay

-- | Parse release dates in JSON.
instance FromJSON Date where
  parseJSON :: Value -> Parser Date
parseJSON Value
Null = Date -> Parser Date
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Day -> Date
Date Maybe Day
forall a. Maybe a
Nothing)
  parseJSON (String Text
t)
    | Text -> Bool
Text.null Text
t = Date -> Parser Date
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Day -> Date
Date Maybe Day
forall a. Maybe a
Nothing)
    | Bool
otherwise = do
      Day
d <- Bool -> TimeLocale -> String -> String -> Parser Day
forall (m :: * -> *) t.
(MonadFail m, ParseTime t) =>
Bool -> TimeLocale -> String -> String -> m t
parseTimeM Bool
True TimeLocale
defaultTimeLocale String
"%Y-%m-%d" (Text -> String
forall a. ToString a => a -> String
toString Text
t)
      Date -> Parser Date
forall (m :: * -> *) a. Monad m => a -> m a
return (Date -> Parser Date) -> Date -> Parser Date
forall a b. (a -> b) -> a -> b
$ Maybe Day -> Date
Date (Day -> Maybe Day
forall a. a -> Maybe a
Just Day
d)
  parseJSON Value
v = String -> Value -> Parser Date
forall a. String -> Value -> Parser a
typeMismatch String
"Date" Value
v