{-# 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.Monoid (Monoid (..))
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)

-- c0 = compile CompilerEnv{} router content

address_static, address_feed :: Address
address_filter :: Maybe Lang -> Maybe (Captured Tag Addresser) -> Address
( address_static
    :!: address_feed
    :!: address_filter
  ) = address router

-- * 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 Lang 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 = OutputPath{outputPathSegs = [unTag tag], outputPathExts = []}
          , outputData = ($ tag)
          , outputType = mempty
          }
        | tag <- Set.toList (modelTags model)
        ]

instance Capturable Tag Addresser where
  -- FIXME: check given tag exists?
  capturePathSegment _n = Addresser \k t ->
    k Address{addressSegs = [unTag t], addressExts = []}

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

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