42 lines
979 B
Haskell
42 lines
979 B
Haskell
{-# OPTIONS_GHC -fno-warn-orphans #-}
|
|
|
|
module Yesod.Core.Instances
|
|
(
|
|
) where
|
|
|
|
import ClassyPrelude.Yesod
|
|
|
|
import Utils (assertM')
|
|
import Control.Lens
|
|
|
|
import Data.ByteString.Builder (toLazyByteString)
|
|
|
|
import System.FilePath ((</>))
|
|
|
|
import Data.Aeson
|
|
|
|
|
|
instance (RenderRoute site, ParseRoute site) => PathPiece (Route site) where
|
|
fromPathPiece
|
|
= parseRoute
|
|
. over (_2.traverse._2) (fromMaybe "")
|
|
. over _2 queryToQueryText
|
|
. decodePath
|
|
. encodeUtf8
|
|
toPathPiece
|
|
= pack
|
|
. ("/" </>)
|
|
. unpack
|
|
. decodeUtf8
|
|
. toLazyByteString
|
|
. uncurry encodePath
|
|
. over _2 queryTextToQuery
|
|
. over (_2.traverse._2) (assertM' $ not . null)
|
|
. renderRoute
|
|
|
|
instance (RenderRoute site, ParseRoute site) => FromJSON (Route site) where
|
|
parseJSON = withText "Route" $ maybe (fail "Could not parse route") return . fromPathPiece
|
|
|
|
instance (RenderRoute site, ParseRoute site) => ToJSON (Route site) where
|
|
toJSON = String . toPathPiece
|