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
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
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
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
"-"
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
"-"
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
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)