{-# LANGUAGE DeriveGeneric #-}
-- For Inferable
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE NoMonomorphismRestriction #-}
{-# OPTIONS_GHC -Wno-missing-signatures #-}

module Examples.Ex03 where

import Control.Monad (Monad (..))
import Control.Monad.Classes qualified as MC
import Data.Eq (Eq)
import Data.Function (($), (.))
import Data.Maybe (Maybe (..), maybe)
import Data.Ord (Ord)
import Data.Set (Set)
import Data.Set qualified as Set
import Data.String (IsString (..))
import GHC.Generics (Generic)
import Text.Show (Show (..))

import Literate.Web

-- | 'dataType' can be used at any point where
-- the Tuples-of-Functions are no longer wanted.
router =
  pathSegment "static"
    <+> pathSegment "feed"
    <+> "filter" </> (dataType @(Maybe Lang) $ pathSegment "all" <+> infer) <.> optional (capturePathSegment @Tag "tag")

-- content ::
--   Monad m =>
--   Sym.ToF
--     (Either () (Either () (Maybe Lang, Maybe Tag)))
--     (m BSL.ByteString)
content =
  contentStatic
    :!: contentFeed
    :!: contentFilter
  where
    contentStatic = return "STATIC"
    contentFeed = return "FEED"
    contentFilter filterLang filterTag =
      return $
        fromString $
          case filterLang of
            Nothing -> maybe "ALL-LANG-ALL-TAGS" show filterTag
            Just lang -> case filterTag of
              Nothing -> show lang
              Just tag -> show (lang, tag)

-- * Type 'Lang'
data Lang
  = LangEn
  | LangFr
  deriving (Eq, Show, Generic)

routeLang = dataType @Lang $ pathSegment "en" <+> pathSegment "fr"

-- | Using 'Inferable' has the downside of requiring
-- to explicit manually the symantices required.
instance (SumFunctor sem, PathSegmentable sem, Dataable sem) => Inferable Lang sem where
  infer = routeLang

-- * Type 'Tag'
newtype Tag = Tag {unTag :: PathSegment} deriving (Eq, Ord, Show)
instance IsString Tag where
  fromString = Tag . fromString

-- | Capturing a 'Tag' makes no sense when compiling a static site.
-- Hence the 'Compiler' semantic for 'Capturable'
-- requires a readable 'Model' somewhere in the monad stack
-- in order to generate all 'Tag's folders.
instance MC.MonadReader Model m => Capturable Tag (Compiler m) where
  capturePathSegment _n =
    Compiler do
      model <- MC.ask
      return
        [ Output{outputPath = [unTag tag], outputExts = [], outputData = tag}
        | tag <- Set.toList (modelTags model)
        ]

-- * Type 'Model'
data Model = Model
  { modelTags :: Set Tag
  }

model1 = Model{modelTags = Set.fromList []}
model2 = Model{modelTags = Set.fromList ["cat1", "cat2", "cat3"]}