{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE NoMonomorphismRestriction #-}
{-# OPTIONS_GHC -Wno-missing-signatures #-}

module Examples.Ex04 where

import Control.Monad.Classes qualified as MC

-- import Control.Reactive
import Data.Map.Strict as Map
import Literate.Web
import Relude

router =
  "post"
    </> capturePathSegment @PostName "post"
    <.> response @Post @'[PlainText]
    <+> "page"
    </> capturePathSegment @PageName "page"
    <.> response @Page @'[PlainText]
    <+> pathSegment "lorem"

-- content ::
--   ( PostName -> (a :~: a, Post)
--   , PageName -> (a :~: a, Page) )
-- content ::
--   MC.MonadReader Model m =>
--   endpoint ~ m Text =>
--   Sym.ToF
--     (Either (PostName, Sym.Endpoint endpoint (m Post))
--             (PageName, Sym.Endpoint endpoint (m Page)))
--     endpoint
content = contentPost :!: contentPage :!: contentOther
  where
    contentPost n = compilerEndpoint do
      Model{..} <- MC.ask
      return $ modelPosts Map.! n
    contentPage =
      compilerEndpoint . \case
        CapturedExtra (Left (_n, p)) -> do
          return p
        CapturedExtra (Right n) -> do
          Model{..} <- MC.ask
          return $ modelPages Map.! n
    contentOther = return "ipsum"

-- c0 = compile CompilerEnv{} router content

instance MimeEncodable Post PlainText where
  mimeEncode (Post t) = mimeEncode @_ @PlainText t
instance MimeEncodable Page PlainText where
  mimeEncode (Page t) = mimeEncode @_ @PlainText t

instance MC.MonadReader Model m => Capturable PostName (Compiler m) where
  capturePathSegment _n =
    Compiler do
      model <- MC.ask
      return
        [ Output
          { outputPath = OutputPath{outputPathSegs = [unPostName name], outputPathExts = []}
          , outputData = ($ name)
          }
        | name <- Map.keys (modelPosts model)
        ]
instance MC.MonadReader Model m => Capturable PageName (Compiler m) where
  -- Keep the 'Page' to avoid looking it up in 'contentPage'.
  type Captured PageName (Compiler m) = CapturedExtra PageName Page
  capturePathSegment _n =
    Compiler do
      model <- MC.ask
      return
        [ Output
          { outputPath = OutputPath{outputPathSegs = [unPageName name], outputPathExts = []}
          , outputData = ($ CapturedExtra (Left (name, page)))
          }
        | (name, page) <- Map.toList (modelPages model)
        ]

{-
data Rodel m = Rodel
  { rodelPosts :: RW m (Map PostName (RW m Post))
  , rodelPages :: RW m (Map PageName (RW m Page))
  }
-}

-- * Type 'Model'
data Model = Model
  { modelPosts :: Map PostName Post
  , modelPages :: Map PageName Page
  }
model1 =
  Model
    { modelPosts =
        Map.fromList
          [ (PostName "post1", Post "post-model-1")
          , (PostName "post2", Post "post-model-2")
          ]
    , modelPages =
        Map.fromList
          [ (PageName "page1", Page "page-model-1")
          , (PageName "page2", Page "page-model-2")
          ]
    }

-- ** Type 'PostName'
data PostName = PostName {unPostName :: PathSegment}
  deriving (Show, Eq, Ord)

-- ** Type 'PageName'
data PageName = PageName {unPageName :: PathSegment}
  deriving (Show, Eq, Ord)

-- ** Type 'Post'
data Post = Post {unPost :: Text}
  deriving (Show)

-- ** Type 'Page'
data Page = Page {unPage :: Text}
  deriving (Show)