{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE DeriveLift #-}
-- | Warning! This module is considered internal and may have breaking changes
module Yesod.Routes.TH.Types
    ( -- * Data types
      Resource (..)
    , ResourceTree (..)
    , Piece (..)
    , Dispatch (..)
    , CheckOverlap
    , FlatResource (..)
      -- ** Helper functions
    , resourceMulti
    , resourceTreePieces
    , resourceTreeName
    , flatten
    ) where

import Language.Haskell.TH.Syntax

data ResourceTree typ
    = ResourceLeaf (Resource typ)
    | ResourceParent String CheckOverlap [Piece typ] [ResourceTree typ]
    deriving (forall typ (m :: * -> *).
(Lift typ, Quote m) =>
ResourceTree typ -> m Exp
forall typ (m :: * -> *).
(Lift typ, Quote m) =>
ResourceTree typ -> Code m (ResourceTree typ)
forall t.
(forall (m :: * -> *). Quote m => t -> m Exp)
-> (forall (m :: * -> *). Quote m => t -> Code m t) -> Lift t
forall (m :: * -> *). Quote m => ResourceTree typ -> m Exp
forall (m :: * -> *).
Quote m =>
ResourceTree typ -> Code m (ResourceTree typ)
liftTyped :: forall (m :: * -> *).
Quote m =>
ResourceTree typ -> Code m (ResourceTree typ)
$cliftTyped :: forall typ (m :: * -> *).
(Lift typ, Quote m) =>
ResourceTree typ -> Code m (ResourceTree typ)
lift :: forall (m :: * -> *). Quote m => ResourceTree typ -> m Exp
$clift :: forall typ (m :: * -> *).
(Lift typ, Quote m) =>
ResourceTree typ -> m Exp
Lift, Int -> ResourceTree typ -> ShowS
forall typ. Show typ => Int -> ResourceTree typ -> ShowS
forall typ. Show typ => [ResourceTree typ] -> ShowS
forall typ. Show typ => ResourceTree typ -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ResourceTree typ] -> ShowS
$cshowList :: forall typ. Show typ => [ResourceTree typ] -> ShowS
show :: ResourceTree typ -> String
$cshow :: forall typ. Show typ => ResourceTree typ -> String
showsPrec :: Int -> ResourceTree typ -> ShowS
$cshowsPrec :: forall typ. Show typ => Int -> ResourceTree typ -> ShowS
Show, forall a b. a -> ResourceTree b -> ResourceTree a
forall a b. (a -> b) -> ResourceTree a -> ResourceTree b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> ResourceTree b -> ResourceTree a
$c<$ :: forall a b. a -> ResourceTree b -> ResourceTree a
fmap :: forall a b. (a -> b) -> ResourceTree a -> ResourceTree b
$cfmap :: forall a b. (a -> b) -> ResourceTree a -> ResourceTree b
Functor)

resourceTreePieces :: ResourceTree typ -> [Piece typ]
resourceTreePieces :: forall typ. ResourceTree typ -> [Piece typ]
resourceTreePieces (ResourceLeaf Resource typ
r) = forall typ. Resource typ -> [Piece typ]
resourcePieces Resource typ
r
resourceTreePieces (ResourceParent String
_ CheckOverlap
_ [Piece typ]
x [ResourceTree typ]
_) = [Piece typ]
x

resourceTreeName :: ResourceTree typ -> String
resourceTreeName :: forall typ. ResourceTree typ -> String
resourceTreeName (ResourceLeaf Resource typ
r) = forall typ. Resource typ -> String
resourceName Resource typ
r
resourceTreeName (ResourceParent String
x CheckOverlap
_ [Piece typ]
_ [ResourceTree typ]
_) = String
x

data Resource typ = Resource
    { forall typ. Resource typ -> String
resourceName :: String
    , forall typ. Resource typ -> [Piece typ]
resourcePieces :: [Piece typ]
    , forall typ. Resource typ -> Dispatch typ
resourceDispatch :: Dispatch typ
    , forall typ. Resource typ -> [String]
resourceAttrs :: [String]
    , forall typ. Resource typ -> CheckOverlap
resourceCheck :: CheckOverlap
    }
    deriving (forall typ (m :: * -> *).
(Lift typ, Quote m) =>
Resource typ -> m Exp
forall typ (m :: * -> *).
(Lift typ, Quote m) =>
Resource typ -> Code m (Resource typ)
forall t.
(forall (m :: * -> *). Quote m => t -> m Exp)
-> (forall (m :: * -> *). Quote m => t -> Code m t) -> Lift t
forall (m :: * -> *). Quote m => Resource typ -> m Exp
forall (m :: * -> *).
Quote m =>
Resource typ -> Code m (Resource typ)
liftTyped :: forall (m :: * -> *).
Quote m =>
Resource typ -> Code m (Resource typ)
$cliftTyped :: forall typ (m :: * -> *).
(Lift typ, Quote m) =>
Resource typ -> Code m (Resource typ)
lift :: forall (m :: * -> *). Quote m => Resource typ -> m Exp
$clift :: forall typ (m :: * -> *).
(Lift typ, Quote m) =>
Resource typ -> m Exp
Lift, Int -> Resource typ -> ShowS
forall typ. Show typ => Int -> Resource typ -> ShowS
forall typ. Show typ => [Resource typ] -> ShowS
forall typ. Show typ => Resource typ -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Resource typ] -> ShowS
$cshowList :: forall typ. Show typ => [Resource typ] -> ShowS
show :: Resource typ -> String
$cshow :: forall typ. Show typ => Resource typ -> String
showsPrec :: Int -> Resource typ -> ShowS
$cshowsPrec :: forall typ. Show typ => Int -> Resource typ -> ShowS
Show, forall a b. a -> Resource b -> Resource a
forall a b. (a -> b) -> Resource a -> Resource b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> Resource b -> Resource a
$c<$ :: forall a b. a -> Resource b -> Resource a
fmap :: forall a b. (a -> b) -> Resource a -> Resource b
$cfmap :: forall a b. (a -> b) -> Resource a -> Resource b
Functor)

type CheckOverlap = Bool

data Piece typ = Static String | Dynamic typ
    deriving (forall typ (m :: * -> *). (Lift typ, Quote m) => Piece typ -> m Exp
forall typ (m :: * -> *).
(Lift typ, Quote m) =>
Piece typ -> Code m (Piece typ)
forall t.
(forall (m :: * -> *). Quote m => t -> m Exp)
-> (forall (m :: * -> *). Quote m => t -> Code m t) -> Lift t
forall (m :: * -> *). Quote m => Piece typ -> m Exp
forall (m :: * -> *). Quote m => Piece typ -> Code m (Piece typ)
liftTyped :: forall (m :: * -> *). Quote m => Piece typ -> Code m (Piece typ)
$cliftTyped :: forall typ (m :: * -> *).
(Lift typ, Quote m) =>
Piece typ -> Code m (Piece typ)
lift :: forall (m :: * -> *). Quote m => Piece typ -> m Exp
$clift :: forall typ (m :: * -> *). (Lift typ, Quote m) => Piece typ -> m Exp
Lift, Int -> Piece typ -> ShowS
forall typ. Show typ => Int -> Piece typ -> ShowS
forall typ. Show typ => [Piece typ] -> ShowS
forall typ. Show typ => Piece typ -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Piece typ] -> ShowS
$cshowList :: forall typ. Show typ => [Piece typ] -> ShowS
show :: Piece typ -> String
$cshow :: forall typ. Show typ => Piece typ -> String
showsPrec :: Int -> Piece typ -> ShowS
$cshowsPrec :: forall typ. Show typ => Int -> Piece typ -> ShowS
Show)

instance Functor Piece where
    fmap :: forall a b. (a -> b) -> Piece a -> Piece b
fmap a -> b
_ (Static String
s)  = forall typ. String -> Piece typ
Static String
s
    fmap a -> b
f (Dynamic a
t) = forall typ. typ -> Piece typ
Dynamic (a -> b
f a
t)

data Dispatch typ =
    Methods
        { forall typ. Dispatch typ -> Maybe typ
methodsMulti :: Maybe typ -- ^ type of the multi piece at the end
        , forall typ. Dispatch typ -> [String]
methodsMethods :: [String] -- ^ supported request methods
        }
    | Subsite
        { forall typ. Dispatch typ -> typ
subsiteType :: typ
        , forall typ. Dispatch typ -> String
subsiteFunc :: String
        }
    deriving (forall typ (m :: * -> *).
(Lift typ, Quote m) =>
Dispatch typ -> m Exp
forall typ (m :: * -> *).
(Lift typ, Quote m) =>
Dispatch typ -> Code m (Dispatch typ)
forall t.
(forall (m :: * -> *). Quote m => t -> m Exp)
-> (forall (m :: * -> *). Quote m => t -> Code m t) -> Lift t
forall (m :: * -> *). Quote m => Dispatch typ -> m Exp
forall (m :: * -> *).
Quote m =>
Dispatch typ -> Code m (Dispatch typ)
liftTyped :: forall (m :: * -> *).
Quote m =>
Dispatch typ -> Code m (Dispatch typ)
$cliftTyped :: forall typ (m :: * -> *).
(Lift typ, Quote m) =>
Dispatch typ -> Code m (Dispatch typ)
lift :: forall (m :: * -> *). Quote m => Dispatch typ -> m Exp
$clift :: forall typ (m :: * -> *).
(Lift typ, Quote m) =>
Dispatch typ -> m Exp
Lift, Int -> Dispatch typ -> ShowS
forall typ. Show typ => Int -> Dispatch typ -> ShowS
forall typ. Show typ => [Dispatch typ] -> ShowS
forall typ. Show typ => Dispatch typ -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Dispatch typ] -> ShowS
$cshowList :: forall typ. Show typ => [Dispatch typ] -> ShowS
show :: Dispatch typ -> String
$cshow :: forall typ. Show typ => Dispatch typ -> String
showsPrec :: Int -> Dispatch typ -> ShowS
$cshowsPrec :: forall typ. Show typ => Int -> Dispatch typ -> ShowS
Show)

instance Functor Dispatch where
    fmap :: forall a b. (a -> b) -> Dispatch a -> Dispatch b
fmap a -> b
f (Methods Maybe a
a [String]
b) = forall typ. Maybe typ -> [String] -> Dispatch typ
Methods (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f Maybe a
a) [String]
b
    fmap a -> b
f (Subsite a
a String
b) = forall typ. typ -> String -> Dispatch typ
Subsite (a -> b
f a
a) String
b

resourceMulti :: Resource typ -> Maybe typ
resourceMulti :: forall typ. Resource typ -> Maybe typ
resourceMulti Resource { resourceDispatch :: forall typ. Resource typ -> Dispatch typ
resourceDispatch = Methods (Just typ
t) [String]
_ } = forall a. a -> Maybe a
Just typ
t
resourceMulti Resource typ
_ = forall a. Maybe a
Nothing

data FlatResource a = FlatResource
    { forall a. FlatResource a -> [(String, [Piece a])]
frParentPieces :: [(String, [Piece a])]
    , forall a. FlatResource a -> String
frName :: String
    , forall a. FlatResource a -> [Piece a]
frPieces :: [Piece a]
    , forall a. FlatResource a -> Dispatch a
frDispatch :: Dispatch a
    , forall a. FlatResource a -> CheckOverlap
frCheck :: Bool
    } deriving (Int -> FlatResource a -> ShowS
forall a. Show a => Int -> FlatResource a -> ShowS
forall a. Show a => [FlatResource a] -> ShowS
forall a. Show a => FlatResource a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FlatResource a] -> ShowS
$cshowList :: forall a. Show a => [FlatResource a] -> ShowS
show :: FlatResource a -> String
$cshow :: forall a. Show a => FlatResource a -> String
showsPrec :: Int -> FlatResource a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> FlatResource a -> ShowS
Show)

flatten :: [ResourceTree a] -> [FlatResource a]
flatten :: forall a. [ResourceTree a] -> [FlatResource a]
flatten =
    forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (forall {a}.
([(String, [Piece a])] -> [(String, [Piece a])])
-> CheckOverlap -> ResourceTree a -> [FlatResource a]
go forall a. a -> a
id CheckOverlap
True)
  where
    go :: ([(String, [Piece a])] -> [(String, [Piece a])])
-> CheckOverlap -> ResourceTree a -> [FlatResource a]
go [(String, [Piece a])] -> [(String, [Piece a])]
front CheckOverlap
check' (ResourceLeaf (Resource String
a [Piece a]
b Dispatch a
c [String]
_ CheckOverlap
check)) = [forall a.
[(String, [Piece a])]
-> String
-> [Piece a]
-> Dispatch a
-> CheckOverlap
-> FlatResource a
FlatResource ([(String, [Piece a])] -> [(String, [Piece a])]
front []) String
a [Piece a]
b Dispatch a
c (CheckOverlap
check' CheckOverlap -> CheckOverlap -> CheckOverlap
&& CheckOverlap
check)]
    go [(String, [Piece a])] -> [(String, [Piece a])]
front CheckOverlap
check' (ResourceParent String
name CheckOverlap
check [Piece a]
pieces [ResourceTree a]
children) =
        forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (([(String, [Piece a])] -> [(String, [Piece a])])
-> CheckOverlap -> ResourceTree a -> [FlatResource a]
go ([(String, [Piece a])] -> [(String, [Piece a])]
front forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((String
name, [Piece a]
pieces)forall a. a -> [a] -> [a]
:)) (CheckOverlap
check CheckOverlap -> CheckOverlap -> CheckOverlap
&& CheckOverlap
check')) [ResourceTree a]
children