{- | A primitive module to eventually pave way towards first-class "calendar"
 (daily notes, etc.) support in Emanote; either built-in or as plugin.
-}
module Emanote.Model.Calendar where

import Data.Time.Calendar (Day, fromGregorianValid)
import Emanote.Model.Note qualified as N
import Emanote.Model.Title (Title)
import Emanote.Model.Type (Model, modelLookupTitle)
import Emanote.Route (LMLRoute)
import Emanote.Route qualified as R
import Relude
import Text.Megaparsec qualified as M
import Text.Megaparsec.Char qualified as M

-- HACK: This is so that calendar backlinks are sorted properly.
backlinkSortKey :: Model -> LMLRoute -> Down Title
backlinkSortKey :: Model -> LMLRoute -> Down Title
backlinkSortKey Model
model =
  forall a. a -> Down a
Down forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b c. (a -> b -> c) -> b -> a -> c
flip forall (f :: Type -> Type). LMLRoute -> ModelT f -> Title
modelLookupTitle Model
model

-- HACK: Until we have a proper search support. This sorts query results for
-- timeline
noteSortKey :: N.Note -> (Down (Maybe Text), LMLRoute)
noteSortKey :: Note -> (Down (Maybe Text), LMLRoute)
noteSortKey Note
note =
  (forall a. a -> Down a
Down forall a b. (a -> b) -> a -> b
$ forall a. FromJSON a => NonEmpty Text -> Note -> Maybe a
N.lookupMeta @Text (forall x. One x => OneItem x -> x
one Text
"date") Note
note, Note -> LMLRoute
N._noteRoute Note
note)

isDailyNote :: LMLRoute -> Bool
isDailyNote :: LMLRoute -> Bool
isDailyNote =
  forall a. Maybe a -> Bool
isJust forall b c a. (b -> c) -> (a -> b) -> a -> c
. LMLRoute -> Maybe Day
parseRouteDay

parseRouteDay :: LMLRoute -> Maybe Day
parseRouteDay :: LMLRoute -> Maybe Day
parseRouteDay =
  forall e s a. (Ord e, Stream s) => Parsec e s a -> s -> Maybe a
M.parseMaybe Parsec Void Text Day
parse forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall r.
(forall (lmlType :: LML).
 HasExt @SourceExt ('LMLType lmlType) =>
 R @SourceExt ('LMLType lmlType) -> r)
-> LMLRoute -> r
R.withLmlRoute forall {a} (ext :: FileType a). R @a ext -> Text
R.routeBaseName
  where
    parse :: M.Parsec Void Text Day
    parse :: Parsec Void Text Day
parse = do
      let asInt :: String -> ParsecT Void Text Identity Integer
asInt = forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall (m :: Type -> Type) a. MonadFail m => String -> m a
fail String
"Not an int") forall (f :: Type -> Type) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Read a => String -> Maybe a
readMaybe
      -- Year
      Integer
year <- String -> ParsecT Void Text Identity Integer
asInt forall (m :: Type -> Type) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall (m :: Type -> Type) a.
Applicative m =>
MonthOfYear -> m a -> m [a]
replicateM MonthOfYear
4 forall e s (m :: Type -> Type).
(MonadParsec e s m, (Token s :: Type) ~ (Char :: Type)) =>
m (Token s)
M.digitChar
      forall (f :: Type -> Type) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ forall e s (m :: Type -> Type).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
M.string Tokens Text
"-"
      -- Month
      Integer
month <- String -> ParsecT Void Text Identity Integer
asInt forall (m :: Type -> Type) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall (m :: Type -> Type) a.
Applicative m =>
MonthOfYear -> m a -> m [a]
replicateM MonthOfYear
2 forall e s (m :: Type -> Type).
(MonadParsec e s m, (Token s :: Type) ~ (Char :: Type)) =>
m (Token s)
M.digitChar
      forall (f :: Type -> Type) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ forall e s (m :: Type -> Type).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
M.string Tokens Text
"-"
      -- Day
      Integer
day <- String -> ParsecT Void Text Identity Integer
asInt forall (m :: Type -> Type) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall (m :: Type -> Type) a.
Applicative m =>
MonthOfYear -> m a -> m [a]
replicateM MonthOfYear
2 forall e s (m :: Type -> Type).
(MonadParsec e s m, (Token s :: Type) ~ (Char :: Type)) =>
m (Token s)
M.digitChar
      -- Optional suffix (ignored)
      forall (f :: Type -> Type) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$
        forall (f :: Type -> Type) a. Alternative f => f a -> f (Maybe a)
optional forall a b. (a -> b) -> a -> b
$ do
          forall (f :: Type -> Type) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ forall (f :: Type -> Type) e s (m :: Type -> Type).
(Foldable f, MonadParsec e s m) =>
f (Token s) -> m (Token s)
M.oneOf [Char
'-', Char
'_', Char
' ']
          forall (f :: Type -> Type) a. Functor f => f a -> f ()
void forall e s (m :: Type -> Type). MonadParsec e s m => m (Tokens s)
M.takeRest
      forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall (m :: Type -> Type) a. MonadFail m => String -> m a
fail String
"Not a date") forall (f :: Type -> Type) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$
        Integer -> MonthOfYear -> MonthOfYear -> Maybe Day
fromGregorianValid Integer
year (forall a. Num a => Integer -> a
fromInteger Integer
month) (forall a. Num a => Integer -> a
fromInteger Integer
day)