module Yesod.OldCrud.Internal where

import Control.Monad.Trans.State (StateT, evalStateT, put, get)
import Control.Monad.Trans.Maybe (MaybeT, runMaybeT)
import Data.Functor.Identity
import Control.Monad
import Yesod.Core
import Control.Applicative
import Data.Text (Text)

runSM :: [Text] -> StateT [Text] (MaybeT Identity) a -> Maybe a
runSM xs a = runIdentity $ runMaybeT $ evalStateT (a <* forceEmpty) xs

consumeMatchingText :: Text -> StateT [Text] (MaybeT Identity) ()
consumeMatchingText t = do
  p <- attemptTakeNextPiece
  guard $ p == t

consumeKey :: PathPiece k => StateT [Text] (MaybeT Identity) k
consumeKey = do
  t <- attemptTakeNextPiece
  case fromPathPiece t of
    Nothing -> mzero
    Just a  -> return a

attemptTakeNextPiece :: StateT [b] (MaybeT Identity) b
attemptTakeNextPiece = do
  s <- get
  case s of
    (a:as) -> put as >> return a
    [] -> mzero

forceEmpty :: StateT [Text] (MaybeT Identity) ()
forceEmpty = do
  s <- get
  case s of
    [] -> return ()
    _  -> mzero

-- import ClassyPrelude.Yesod
-- import Yesod.Core
-- import Yesod.Core.Types
-- import qualified Network.Wai as W
-- 
-- subHelper :: Monad m 
--           => HandlerT child (HandlerT parent m) TypedContent
--           -> YesodSubRunnerEnv child parent (HandlerT parent m)
--           -> Maybe (Route child)
--           -> W.Application
-- subHelper handlert YesodSubRunnerEnv {..} route =
--     ysreParentRunner base ysreParentEnv (fmap ysreToParentRoute route)
--   where
--     base = stripHandlerT (fmap toTypedContent handlert) ysreGetSub ysreToParentRoute route
-- 
-- stripHandlerT :: HandlerT child (HandlerT parent m) a
--               -> (parent -> child)
--               -> (Route child -> Route parent)
--               -> Maybe (Route child)
--               -> HandlerT parent m a
-- stripHandlerT (HandlerT f) getSub toMaster newRoute = HandlerT $ \hd -> do
--     let env = handlerEnv hd
--     ($ hd) $ unHandlerT $ f hd
--         { handlerEnv = env
--             { rheSite = getSub $ rheSite env
--             , rheRoute = newRoute
--             , rheRender = \url params -> rheRender env (toMaster url) params
--             }
--         , handlerToParent = toMaster
--         }