{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE TemplateHaskell #-}

module Emanote.Model.StaticFile where

import Commonmark.Extensions.WikiLink qualified as WL
import Data.Aeson qualified as Aeson
import Data.IxSet.Typed (Indexable (..), IxSet, ixFun, ixList)
import Data.Time (UTCTime)
import Emanote.Route qualified as R
import Optics.TH (makeLenses)
import Relude

data StaticFile = StaticFile
  { StaticFile -> R @SourceExt 'AnyExt
_staticFileRoute :: R.R 'R.AnyExt,
    StaticFile -> FilePath
_staticFilePath :: FilePath,
    -- | Indicates that this file was updated no latter than the given time.
    StaticFile -> UTCTime
_staticFileTime :: UTCTime
  }
  deriving stock (StaticFile -> StaticFile -> Bool
(StaticFile -> StaticFile -> Bool)
-> (StaticFile -> StaticFile -> Bool) -> Eq StaticFile
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: StaticFile -> StaticFile -> Bool
$c/= :: StaticFile -> StaticFile -> Bool
== :: StaticFile -> StaticFile -> Bool
$c== :: StaticFile -> StaticFile -> Bool
Eq, Eq StaticFile
Eq StaticFile
-> (StaticFile -> StaticFile -> Ordering)
-> (StaticFile -> StaticFile -> Bool)
-> (StaticFile -> StaticFile -> Bool)
-> (StaticFile -> StaticFile -> Bool)
-> (StaticFile -> StaticFile -> Bool)
-> (StaticFile -> StaticFile -> StaticFile)
-> (StaticFile -> StaticFile -> StaticFile)
-> Ord StaticFile
StaticFile -> StaticFile -> Bool
StaticFile -> StaticFile -> Ordering
StaticFile -> StaticFile -> StaticFile
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: StaticFile -> StaticFile -> StaticFile
$cmin :: StaticFile -> StaticFile -> StaticFile
max :: StaticFile -> StaticFile -> StaticFile
$cmax :: StaticFile -> StaticFile -> StaticFile
>= :: StaticFile -> StaticFile -> Bool
$c>= :: StaticFile -> StaticFile -> Bool
> :: StaticFile -> StaticFile -> Bool
$c> :: StaticFile -> StaticFile -> Bool
<= :: StaticFile -> StaticFile -> Bool
$c<= :: StaticFile -> StaticFile -> Bool
< :: StaticFile -> StaticFile -> Bool
$c< :: StaticFile -> StaticFile -> Bool
compare :: StaticFile -> StaticFile -> Ordering
$ccompare :: StaticFile -> StaticFile -> Ordering
Ord, Int -> StaticFile -> ShowS
[StaticFile] -> ShowS
StaticFile -> FilePath
(Int -> StaticFile -> ShowS)
-> (StaticFile -> FilePath)
-> ([StaticFile] -> ShowS)
-> Show StaticFile
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [StaticFile] -> ShowS
$cshowList :: [StaticFile] -> ShowS
show :: StaticFile -> FilePath
$cshow :: StaticFile -> FilePath
showsPrec :: Int -> StaticFile -> ShowS
$cshowsPrec :: Int -> StaticFile -> ShowS
Show, (forall x. StaticFile -> Rep StaticFile x)
-> (forall x. Rep StaticFile x -> StaticFile) -> Generic StaticFile
forall x. Rep StaticFile x -> StaticFile
forall x. StaticFile -> Rep StaticFile x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep StaticFile x -> StaticFile
$cfrom :: forall x. StaticFile -> Rep StaticFile x
Generic)
  deriving anyclass ([StaticFile] -> Encoding
[StaticFile] -> Value
StaticFile -> Encoding
StaticFile -> Value
(StaticFile -> Value)
-> (StaticFile -> Encoding)
-> ([StaticFile] -> Value)
-> ([StaticFile] -> Encoding)
-> ToJSON StaticFile
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [StaticFile] -> Encoding
$ctoEncodingList :: [StaticFile] -> Encoding
toJSONList :: [StaticFile] -> Value
$ctoJSONList :: [StaticFile] -> Value
toEncoding :: StaticFile -> Encoding
$ctoEncoding :: StaticFile -> Encoding
toJSON :: StaticFile -> Value
$ctoJSON :: StaticFile -> Value
Aeson.ToJSON)

type StaticFileIxs = '[R.R 'R.AnyExt, WL.WikiLink]

type IxStaticFile = IxSet StaticFileIxs StaticFile

instance Indexable StaticFileIxs StaticFile where
  indices :: IxList StaticFileIxs StaticFile
indices =
    Ix (R @SourceExt 'AnyExt) StaticFile
-> Ix WikiLink StaticFile -> IxList StaticFileIxs StaticFile
forall (ixs :: [Type]) a r. MkIxList ixs ixs a r => r
ixList
      ((StaticFile -> [R @SourceExt 'AnyExt])
-> Ix (R @SourceExt 'AnyExt) StaticFile
forall ix a. Ord ix => (a -> [ix]) -> Ix ix a
ixFun ((StaticFile -> [R @SourceExt 'AnyExt])
 -> Ix (R @SourceExt 'AnyExt) StaticFile)
-> (StaticFile -> [R @SourceExt 'AnyExt])
-> Ix (R @SourceExt 'AnyExt) StaticFile
forall a b. (a -> b) -> a -> b
$ R @SourceExt 'AnyExt -> [R @SourceExt 'AnyExt]
forall x. One x => OneItem x -> x
one (R @SourceExt 'AnyExt -> [R @SourceExt 'AnyExt])
-> (StaticFile -> R @SourceExt 'AnyExt)
-> StaticFile
-> [R @SourceExt 'AnyExt]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StaticFile -> R @SourceExt 'AnyExt
_staticFileRoute)
      ((StaticFile -> [WikiLink]) -> Ix WikiLink StaticFile
forall ix a. Ord ix => (a -> [ix]) -> Ix ix a
ixFun ((StaticFile -> [WikiLink]) -> Ix WikiLink StaticFile)
-> (StaticFile -> [WikiLink]) -> Ix WikiLink StaticFile
forall a b. (a -> b) -> a -> b
$ NonEmpty WikiLink -> [WikiLink]
forall (t :: Type -> Type) a. Foldable t => t a -> [a]
toList (NonEmpty WikiLink -> [WikiLink])
-> (StaticFile -> NonEmpty WikiLink) -> StaticFile -> [WikiLink]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StaticFile -> NonEmpty WikiLink
staticFileSelfRefs)

staticFileSelfRefs :: StaticFile -> NonEmpty WL.WikiLink
staticFileSelfRefs :: StaticFile -> NonEmpty WikiLink
staticFileSelfRefs =
  ((WikiLinkType, WikiLink) -> WikiLink)
-> NonEmpty (WikiLinkType, WikiLink) -> NonEmpty WikiLink
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap (WikiLinkType, WikiLink) -> WikiLink
forall a b. (a, b) -> b
snd
    (NonEmpty (WikiLinkType, WikiLink) -> NonEmpty WikiLink)
-> (StaticFile -> NonEmpty (WikiLinkType, WikiLink))
-> StaticFile
-> NonEmpty WikiLink
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HasCallStack => NonEmpty Slug -> NonEmpty (WikiLinkType, WikiLink)
NonEmpty Slug -> NonEmpty (WikiLinkType, WikiLink)
WL.allowedWikiLinks
    (NonEmpty Slug -> NonEmpty (WikiLinkType, WikiLink))
-> (StaticFile -> NonEmpty Slug)
-> StaticFile
-> NonEmpty (WikiLinkType, WikiLink)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. R @SourceExt 'AnyExt -> NonEmpty Slug
forall a (ext :: FileType a). R @a ext -> NonEmpty Slug
R.unRoute
    (R @SourceExt 'AnyExt -> NonEmpty Slug)
-> (StaticFile -> R @SourceExt 'AnyExt)
-> StaticFile
-> NonEmpty Slug
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StaticFile -> R @SourceExt 'AnyExt
_staticFileRoute

makeLenses ''StaticFile