Path.hs

{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE ViewPatterns #-}

module Matcha.Path where

import Data.Either (rights)
import Data.Text (Text)
import Web.HttpApiData (
    FromHttpApiData (parseUrlPiece),
    ToHttpApiData (toUrlPiece),
 )

pattern Param :: (ToHttpApiData a, FromHttpApiData a) => a -> Text
pattern Param x <- (parseUrlPiece -> Right x)
    where
        Param x = toUrlPiece x

pattern Blob :: (ToHttpApiData a, FromHttpApiData a) => [a] -> [Text]
pattern Blob l <- (rights . map parseUrlPiece -> l)
    where
        Blob l = map toUrlPiece l

pattern (:/) :: (ToHttpApiData a, FromHttpApiData a) => a -> [Text] -> [Text]
pattern h :/ t <- ((parseUrlPiece -> Right h) : t)
    where
        h :/ t = toUrlPiece h : t

pattern (:/*) :: (ToHttpApiData a, ToHttpApiData b, FromHttpApiData a, FromHttpApiData b) => a -> [b] -> [Text]
pattern h :/* t <- ((parseUrlPiece -> Right h) : Blob t)
    where
        h :/* t = toUrlPiece h : map toUrlPiece t

infixr 8 :/
infixr 9 :/*

pattern MyUrl :: Int -> Float -> [Bool] -> [Text]
pattern MyUrl x y bs = (x :: Int) :/ (y :: Float) :/ Blob @Bool bs

pattern MyOtherUrl :: Int -> Float -> [Bool] -> [Text]
pattern MyOtherUrl x y bs = (x :: Int) :/ (y :: Float) :/* bs

url :: [Text]
url = (5 :: Int) :/ (5.6 :: Float) :/ Blob @Bool [True, False, False, True, False]

matchUrl :: [Text] -> Maybe (Int, Float)
matchUrl (int :/ float :/* ([] :: [Text])) = Just (int, float)
matchUrl _ = Nothing