module Yu.Core.Control
( Controly(..)
, getUrlR
, putUrlR
, deleteUrlR
) where
import Yesod.Core
import Yu.Core.Control.Internal
import Yu.Core.Model
import Yu.Core.View
import Yu.Import.Aeson
import qualified Yu.Import.ByteString as B
import Yu.Import.Text (Text)
import qualified Yu.Import.Text as T
import Yu.Utils.Handler
getUrlR :: Controly site
=> [T.Text]
-> HandlerT site IO TypedContent
getUrlR idx@(".query":_) = getQueryR idx =<< runDbDefault (fetchRes idx)
getUrlR idx = do
res <- runDbDefault $ fetchRes idx
case rType <$> res of
Just "post" -> getPostR res
Just "text" -> getResourceR True res
Just "binary" -> getResourceR False res
Just "static" -> getStaticR res
_ -> liftIO (print res) >> notFound
putUrlR :: Controly site
=> [Text]
-> HandlerT site IO TypedContent
putUrlR (".query":".nav":_) = putNavR
putUrlR idx = do
typ <- lookupPostParam "type"
case typ of
Just "post" -> putPostR idx
Just "text" -> putResourceR True idx
Just "binary" -> putResourceR False idx
Just "static" -> putStaticR idx
Just "frame" -> putFrameR idx
Just "query" -> putQueryR idx
_ -> notFound
deleteUrlR :: Controly site
=> [Text]
-> HandlerT site IO TypedContent
deleteUrlR (".query":".nav":_) = delNavR
deleteUrlR idx = do
typ <- lookupPostParam "type"
db <- case typ of
Just "post" -> return "post"
Just "text" -> return "resource"
Just "binary" -> return "resource"
Just "static" -> return "static"
Just "query" -> return "query"
Just "frame" -> return "frame"
_ -> notFound
rt <- tryH.runDbDefault $ deleteItem idx db
case rt of
Left e -> returnEH e
Right _ -> returnSucc
getPostR :: Controly site
=> Maybe ResT
-> HandlerT site IO TypedContent
getPostR (Just res@ResT{..}) = do
html <- runDbDefault $ fetchPost res
case html of
Just pH -> respondPost res pH
_ -> liftIO (putStrLn "Faile to get") >> notFound
getPostR _ = notFound
putPostR :: Controly site
=> [Text]
-> HandlerT site IO TypedContent
putPostR idx = do
unR <- lookupPostUnResT idx
html <- T.decodeUtf8 <#> getFile "html"
putItem unR html updatePost
getResourceR :: Controly site
=> Bool
-> Maybe ResT
-> HandlerT site IO TypedContent
getResourceR t (Just res@ResT{..}) = do
ct <- runDbDefault $ fetchItem res
case ct of
Just (Left text) -> respondResourceT res text
Just (Right binary) -> respondResourceB res binary
_ -> notFound
where
fetchItem :: Controly site
=> ResT
-> Action (HandlerT site IO) (Maybe (Either T.Text B.ByteString))
fetchItem = if t
then (Left <#>) <$> fetchResourceT
else (Right <#>) <$> fetchResourceB
getResourceR _ _ = notFound
putResourceR :: Controly site
=> Bool
-> [T.Text]
-> HandlerT site IO TypedContent
putResourceR t idx = do
unR <- lookupPostUnResT idx
text <- T.decodeUtf8 <#> getFile "text"
bin <- getFile "binary"
if t
then putItem unR text updateResourceT
else putItem unR (Binary <$> bin) updateResourceB
getStaticR :: Controly site
=> Maybe ResT
-> HandlerT site IO TypedContent
getStaticR (Just res@ResT{..}) = do
url <- runDbDefault $ fetchStatic res
case url of
Just u -> respondStatic res u
_ -> notFound
getStaticR _ = notFound
putStaticR :: Controly site
=> [Text]
-> HandlerT site IO TypedContent
putStaticR idx = do
unR <- lookupPostUnResT idx
url <- lookupPostParam "url"
putItem unR url updateStatic
putFrameR :: Controly site
=> [T.Text]
-> HandlerT site IO TypedContent
putFrameR idx = do
unR <- lookupPostUnResT idx
html <- T.decodeUtf8 <#> getFile "html"
putItem unR html updateFrame
getQueryR :: Controly site
=> [Text]
-> Maybe ResT
-> HandlerT site IO TypedContent
getQueryR idx r =
case tail idx of
".version":"author":_ -> queryVersionAuthor
".version":"utils":_ -> queryVersionUtils
".version":"core":_ -> queryVersionCore
".version":_ -> queryVersion
".name":_ -> queryName
".buildinfo":_ -> queryBuildInfo
".servertime":_ -> queryServerTime
".nav":_ -> runDbDefault fetchNav >>= queryNav
".index":xs -> runDbDefault fetchResAll >>= queryIndex (T.unpack $ T.concat xs)
_ -> runDbDefault (fetchMaybeR fetchQuery r)
>>= (\t -> case t of
Just text -> queryQuery text
_ -> notFound
)
putQueryR :: Controly site
=> [T.Text]
-> HandlerT site IO TypedContent
putQueryR idx = do
unR <- lookupPostUnResT idx
var <- lookupPostParam "var"
putItem unR var updateQuery
putNavR :: Controly site
=> HandlerT site IO TypedContent
putNavR = do
idx <- lookupPostParam "label"
url <- lookupPostParam "url"
order <- lookupPostParam "order"
runDbDefault $ updateNav idx url (T.read <$> order)
returnSucc
delNavR :: Controly site
=> HandlerT site IO TypedContent
delNavR = do
idx <- lookupPostParam "label"
runDbDefault $ deleteNav idx
returnSucc