{-# OPTIONS_GHC
  -Wall
  -Wno-unused-imports
  -Wno-unused-top-binds
  -Wno-name-shadowing
#-}
{-# language NoImplicitPrelude #-}
{-# language RecordWildCards #-}
{-# language FlexibleContexts #-}
{-# language TemplateHaskell #-}
{-# language ViewPatterns #-}
{-# language OverloadedStrings #-}
{-# language QuasiQuotes #-}

module CosmicCalendar where

import Rebase.Prelude
import qualified Rebase.Prelude as Prelude
import Control.Lens hiding ((<|))
import Data.Foldable (toList)
import Data.Ratio
import Text.Printf
import Data.Time.Calendar.OrdinalDate
import Data.Time.LocalTime
import Control.Monad.RWS
import Data.Time.Calendar.OrdinalDate
import Data.Text.Format.Numbers
import NeatInterpolation
import qualified Data.Text as Text
import Data.Text (Text, pack, unpack)

import Rebase.Data.Map.Strict (Map)
import qualified Rebase.Data.Map.Strict as Map

-- 13.787±0.020 billion years.  Source: https://en.wikipedia.org/wiki/Age_of_the_universe#cite_note-Planck_2018-2
ageOfUniverseInYears :: Integer
ageOfUniverseInYears = 13787 * 1000 * 1000

-- The point of the cosmic calendar is to mentally visualize or model the scale
-- of cosmic/geologic/evolutionary events using the existing internal mental
-- model of the year. This internal mental model of the year is NOT a 365.2422
-- day earth rotation, but a 365 day calendar year.
--
-- In order to make the math of the calendar work out, the functions that look
-- up calendary entries (and take as input the LocalTime) must check for leap
-- year, and subtract one day from the input if it is later than February.
daysPerYear :: NominalDiffTime
daysPerYear = 365 -- NOT 365.2422

lengthOfDay :: NominalDiffTime
lengthOfDay = 24 * 60 * 60

lengthOfYear :: NominalDiffTime
lengthOfYear = daysPerYear * lengthOfDay

ageOfUniverse :: NominalDiffTime
ageOfUniverse = fromIntegral ageOfUniverseInYears * lengthOfYear

data CalendarEntry = CalendarEntry {
  calBeginTime :: NominalDiffTime,
  calEndTime :: Maybe NominalDiffTime,
  calTitle :: Text,
  calSubtitle :: Text,
  calDescription :: Text,
  calReferences :: Text
} deriving (Show)

-- TODO: Encode the input times like so:
--
-- data CosmicTime = YearsAgo Rational | YearsAfterBigBang Rational | YearsBCE Rational | YearsCE Rational
--
-- The absolute time values (YearsBCE and YearsCE) will be computed using the
-- year at program start:

currentYear :: Integer
currentYear = unsafePerformIO $ getZonedTime <&> toGregorian . localDay . zonedTimeToLocalTime <&> view _1

years :: Rational -> NominalDiffTime
years = (* lengthOfYear) . fromRational

yearsAgo :: Rational -> NominalDiffTime
yearsAgo (fromRational -> n) = lengthOfYear * (1 - (n / fromIntegral ageOfUniverseInYears))

afterBigBang :: NominalDiffTime -> NominalDiffTime
afterBigBang = (/ ageOfUniverse) . (* lengthOfYear)

thousandYears :: Rational -> NominalDiffTime
thousandYears = years . (* 1000)

millionYears :: Rational -> NominalDiffTime
millionYears = thousandYearsAgo . (* 1000)

billionYears :: Rational -> NominalDiffTime
billionYears = millionYearsAgo . (* 1000)

thousandYearsAgo :: Rational -> NominalDiffTime
thousandYearsAgo = yearsAgo . (* 1000)

millionYearsAgo :: Rational -> NominalDiffTime
millionYearsAgo = thousandYearsAgo . (* 1000)

billionYearsAgo :: Rational -> NominalDiffTime
billionYearsAgo = millionYearsAgo . (* 1000)

yearStart :: LocalTime -> LocalTime
yearStart (LocalTime d _) = LocalTime d' t'
  where
    d' = fromGregorian y 1 1
    t' = TimeOfDay 0 0 0
    (y, _, _) = toGregorian d

localTimeToYearElapsed :: LocalTime -> NominalDiffTime
localTimeToYearElapsed t = t `diffLocalTime` yearStart t

getPreviousCalendarEntry :: Calendar -> LocalTime -> Maybe CalendarEntry
getPreviousCalendarEntry cal (localTimeToYearElapsed -> t) = snd <$> Map.lookupLT t cal

getCurrentCalendarEntry :: Calendar -> LocalTime -> Maybe CalendarEntry
getCurrentCalendarEntry cal (localTimeToYearElapsed -> t) = snd <$> Map.lookupLE t cal

type Calendar = Map NominalDiffTime CalendarEntry

getNextCalendarEntry :: Calendar -> LocalTime -> Maybe CalendarEntry
getNextCalendarEntry cal (localTimeToYearElapsed -> t) = snd <$> Map.lookupGT t cal

unwrap :: CalendarEntry -> CalendarEntry
unwrap x@CalendarEntry{..} = x { calDescription = unwrapText calDescription }
  where
    unwrapText :: Text -> Text
    unwrapText = pack . unlines . map unwords . foldr process [] . lines . unpack
    process line [] = [[line]]
    process line ((x:xs):ys) | shouldMerge line x = (line:x:xs):ys
    process line rest = [line]:rest
    shouldMerge :: String -> String -> Bool
    shouldMerge "" _ = False
    shouldMerge _ "" = False
    shouldMerge _ _  = True