{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE LambdaCase #-}
{-|
This module should be mostly used for matching the 'Nero.Url.Path' of a 'Nero.Request.Request', also known as __routing__.
-}
module Nero.Match
  (
  -- * Matching
    Match
  , match
  , prefixed
  , suffixed
  , exact
  , sep
  -- * Results handling
  , Target(..)
  ) where

import Text.Read (readMaybe)
import Data.Text.Lazy (Text)
import qualified Data.Text.Lazy as T
import Data.Bitraversable (bitraverse)

import Nero.Prelude

-- $setup
-- >>> :set -XOverloadedStrings
-- >>> import Control.Lens.Extras (is)

-- * Matching

-- | This contains matched 'Text' in reverse order to how it was matched.
type Match = [Text]

-- | This is just @to pure@ with a refined type.
match :: Getter Text Match
match = to pure

-- | This 'Prism'' /strips\/prepends/ a prefix to the first element of a 'Match'.
--
-- >>> pure "/hello/there" ^? prefixed "/hello/" . _head
-- Just "there"
--
-- >>> prefixed "/hello/" # pure "there" & view _head
-- "/hello/there"
--
-- If matching the entire source it previews to an empty 'Text'. You might
-- use 'exact' if you are expecting this behavior.
--
-- >>> pure "hello" ^? prefixed "hello" . _head
-- Just ""
--
-- This also means that to 'review' an entire source, you need to give it
-- an empty 'Text'.
--
-- >>> prefixed "hello" # pure mempty & view _head
-- "hello"
--
-- An empty 'Match' matches to itself regardless of the pattern.
--
-- >>> preview (prefixed "hello") (review (prefixed "hello") mempty) <&> is _Empty
-- Just True
prefixed :: Text -> Prism' Match Match
prefixed pat = prism'
    (_head %~ (pat <>))
    (\src -> case uncons src of
        Just (h,t) -> T.stripPrefix pat h <&> (<| t)
        Nothing -> Just mempty)

-- | This 'Prism'' /strips\/appends/ a suffix to the first value of a 'Match'.
--
-- >>> pure "/hello/there" ^? suffixed "there" . _head
-- Just "/hello/"
--
-- >>> suffixed "there" # pure "/hello/" & view _head
-- "/hello/there"
--
-- If matching the entire source it previews to an empty 'Text'. You might
-- use 'exact' if you are expecting this behavior.
--
-- >>> pure "hello" ^? suffixed "hello" . _head
-- Just ""
--
-- This also means that to 'review' an entire source, you need to give it
-- an empty 'Text'.
--
-- >>> suffixed "hello" # pure mempty & view _head
-- "hello"
--
-- An empty 'Match' matches to itself regardless of the pattern.
--
-- >>> preview (suffixed "hello") (review (suffixed "hello") mempty) <&> is _Empty
-- Just True
suffixed :: Text -> Prism' Match Match
suffixed pat = prism'
    (_head %~ (<> pat))
    (\src -> case uncons src of
        Just (h,t) -> T.stripSuffix pat h <&> (<| t)
        Nothing -> Just mempty)

-- | This 'Prism'' /splits\/joins/ at the first occurrence of a boundary
--   for the first value of a 'Match'.
--
-- >>> pure "hello/out/there" ^? sep "/" <&> toListOf folded
-- Just ["out/there","hello"]
--
-- >>> sep "/" # (pure "out/there" <> pure "hello") & view _head
-- "hello/out/there"
--
-- Notice what happens when there is no source before or after a boundary:
--
-- >>> pure "hello/" ^? sep "/"
-- Just ["","hello"]
-- >>> (pure "hello/" <> pure "there") ^? sep "/"
-- Just ["","hello","there"]
--
-- >>> pure "/hello" ^? sep "/"
-- Just ["hello",""]
-- >>> (pure "/hello" <> pure "there") ^? sep "/"
-- Just ["hello","","there"]
--
-- When the source /is/ identical to the boundary:
-- >>> pure "hello" ^? sep "hello"
-- Just []
sep :: Text -> Prism' Match Match
sep pat = prism'
    (\trg -> case uncons trg of
        Nothing -> pure pat
        Just (h1,t1) -> case uncons t1 of
            Nothing -> pat <| pure h1
            Just (h2,t2) -> h2 <> pat <> h1 <| t2)
    (\src -> case uncons src of
        Nothing -> Nothing
        Just (h1,t) ->
            if h1 == pat
               then Just t
               else case breakOn pat h1 of
                    Nothing -> Nothing
                    Just (x,y) ->  Just $ y <| x <| t)

-- | This is just an alias to 'only'. Use this to match the entirety of
--   the source. The source mustn't be lifted to a 'Match'.
--
-- >>> "hello" ^? exact "hello"
-- Just ()
exact :: Text -> Prism' Text ()
exact = only

-- * Result handling

-- | 'Prism'' between a 'Match' and a target type.
class Target a where
    target :: Prism' Match a

instance Target Match where
    target = id

instance Target Text where
    target = prism'
        pure
        (\src -> src ^.. folded & \case
            [x] -> Just x
            _ -> Nothing)

instance Target Int where
    target = prism'
        (pure . T.pack . show)
        (\src -> src ^.. folded & \case
            [v] -> readMaybe . T.unpack $ v
            _ -> Nothing)

instance Target Float where
    target = prism'
        (pure . T.pack . show)
        (\src -> src ^.. folded & \case
            [v] -> readMaybe . T.unpack $ v
            _ -> Nothing)

instance (Target a, Target b) => Target (a,b) where
    target = prism'
        (\(t1,t2) -> target # t2 <> target # t1)
        (\src -> src ^.. folded & \case
                [v2,v1] -> bitraverse (preview target)
                                      (preview target)
                                      (pure v1, pure v2)
                _ -> Nothing)

-- * Internal

-- | Like 'T.breakOn' but discards the needle and wraps `Maybe` when there is no
--   needle. When the needle is empty it breaks until the end.
breakOn :: Text -> Text -> Maybe (Text,Text)
breakOn pat src
    | T.null pat = Just (src, mempty)
    | otherwise  =
        let (x,m) = T.breakOn pat src
         in case T.stripPrefix pat m of
                 Just y  -> Just (x,y)
                 Nothing -> Nothing