{-# LANGUAGE
    GADTs
  , DataKinds
  , RankNTypes
  , TypeOperators
  , KindSignatures
  , OverloadedStrings
  , MultiParamTypeClasses
  , FunctionalDependencies
  #-}

{- |
Module      : Web.Routes.Nested.Match
Copyright   : (c) 2015, 2016, 2017, 2018 Athan Clark

License     : BSD-style
Maintainer  : athan.clark@gmail.com
Stability   : experimental
Portability : GHC
-}

module Web.Routes.Nested.Match
  ( -- * Path Combinators
    o_
  , origin_
  , l_
  , literal_
  , f_
  , file_
  , p_
  , parse_
  , r_
  , regex_
  , pred_
  , (</>)
  , -- ** Path Types
    EitherUrlChunk
  , UrlChunks
  , ToUrlChunks (..)
  ) where

import Prelude              hiding (pred)
import Data.Attoparsec.Text (Parser, parseOnly)
import Text.Regex           (Regex, matchRegex)
import qualified Data.Text  as T
import Control.Monad        (guard)
import Control.Error        (hush)
import Data.Trie.Pred       (PathChunk, PathChunks, pred, nil, only, (./))


o_, origin_ :: UrlChunks '[]
o_ :: UrlChunks '[]
o_ = UrlChunks '[]
origin_

-- | The /Origin/ chunk - the equivalent to @[]@
origin_ :: UrlChunks '[]
origin_ = forall k. PathChunks k '[]
nil


l_, literal_ :: T.Text -> EitherUrlChunk 'Nothing
l_ :: Text -> EitherUrlChunk 'Nothing
l_ = Text -> EitherUrlChunk 'Nothing
literal_

-- | Match against a /Literal/ chunk
literal_ :: Text -> EitherUrlChunk 'Nothing
literal_ = forall k. k -> PathChunk k 'Nothing
only

f_, file_ :: T.Text -> EitherUrlChunk ('Just T.Text)
f_ :: Text -> EitherUrlChunk ('Just Text)
f_ = Text -> EitherUrlChunk ('Just Text)
file_

-- | Removes file extension from the matchedhttp://hackage.haskell.org/package/nested-routes route
file_ :: Text -> EitherUrlChunk ('Just Text)
file_ Text
f = forall r. Text -> (Text -> Maybe r) -> EitherUrlChunk ('Just r)
pred_ Text
f (\Text
t -> Text
t forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall (f :: * -> *). Alternative f => Bool -> f ()
guard (forall a b. (a, b) -> a
fst (Text -> Text -> (Text, Text)
T.breakOn Text
"." Text
t) forall a. Eq a => a -> a -> Bool
== Text
f))


p_, parse_ :: T.Text -> Parser r -> EitherUrlChunk ('Just r)
p_ :: forall r. Text -> Parser r -> EitherUrlChunk ('Just r)
p_ = forall r. Text -> Parser r -> EitherUrlChunk ('Just r)
parse_

-- | Match against a /Parsed/ chunk, with <https://hackage.haskell.org/package/attoparsec attoparsec>.
parse_ :: forall r. Text -> Parser r -> EitherUrlChunk ('Just r)
parse_ Text
i Parser r
q = forall r. Text -> (Text -> Maybe r) -> EitherUrlChunk ('Just r)
pred_ Text
i (forall a b. Either a b -> Maybe b
hush forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Parser a -> Text -> Either String a
parseOnly Parser r
q)


r_, regex_ :: T.Text -> Regex -> EitherUrlChunk ('Just [String])
r_ :: Text -> Regex -> EitherUrlChunk ('Just [String])
r_ = Text -> Regex -> EitherUrlChunk ('Just [String])
regex_

-- | Match against a /Regular expression/ chunk, with <https://hackage.haskell.org/package/regex-compat regex-compat>.
regex_ :: Text -> Regex -> EitherUrlChunk ('Just [String])
regex_ Text
i Regex
q = forall r. Text -> (Text -> Maybe r) -> EitherUrlChunk ('Just r)
pred_ Text
i (Regex -> String -> Maybe [String]
matchRegex Regex
q forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack)

-- | Match with a predicate against the url chunk directly.
pred_ :: T.Text -> (T.Text -> Maybe r) -> EitherUrlChunk ('Just r)
pred_ :: forall r. Text -> (Text -> Maybe r) -> EitherUrlChunk ('Just r)
pred_ = forall k r. k -> (k -> Maybe r) -> PathChunk k ('Just r)
pred


-- | Constrained to AttoParsec, Regex-Compat and T.Text
type EitherUrlChunk = PathChunk T.Text


-- | Container when defining route paths
type UrlChunks = PathChunks T.Text



-- | Prefix a routable path by more predicative lookup data.
(</>) :: EitherUrlChunk mx -> UrlChunks xs -> UrlChunks (mx ': xs)
</> :: forall (mx :: Maybe (*)) (xs :: [Maybe (*)]).
EitherUrlChunk mx -> UrlChunks xs -> UrlChunks (mx : xs)
(</>) = forall k (mx :: Maybe (*)) (xs :: [Maybe (*)]).
PathChunk k mx -> PathChunks k xs -> PathChunks k (mx : xs)
(./)

infixr 9 </>



class ToUrlChunks a (xs :: [Maybe *]) | a -> xs where
  toUrlChunks :: a -> UrlChunks xs