{-# LANGUAGE InstanceSigs #-}

module Literate.Web.Types.URL (
  Path,
  encodePath,
  PathSegment (unPathSegment),
  decodePathSegment,
  encodePathSegment,
) where

import Data.Data (Data)
import Data.Eq (Eq)
import Data.Function (($), (.))
import Data.Functor ((<$>))
import Data.List (isInfixOf)
import Data.Ord (Ord)
import Data.Semigroup (Semigroup (..))
import Data.String (IsString (..), String)
import Data.Text (Text)
import Data.Text qualified as Text
import Data.Text.Normalize qualified as UT
import GHC.Generics (Generic)
import GHC.Stack (HasCallStack)
import Network.URI.Encode qualified as UE
import Text.Show (Show)
import Prelude (FilePath, error)

-- * Type 'Path'
type Path = [PathSegment]

encodePath :: [PathSegment] -> FilePath
encodePath s =
  Text.unpack $
    Text.intercalate (Text.singleton '/') $
      encodePathSegment <$> s

-- ** Type 'PathSegment'
newtype PathSegment = PathSegment {unPathSegment :: Text}
  deriving (Eq, Show, Ord, Data, Generic)

instance IsString PathSegment where
  fromString :: HasCallStack => String -> PathSegment
  fromString s =
    if "/" `isInfixOf` s
      then error ("PathSegment cannot contain a slash: " <> s)
      else PathSegment (normalizeUnicode (fromString s))

encodePathSegment :: PathSegment -> Text
encodePathSegment = UE.encodeText . unPathSegment

decodePathSegment :: Text -> PathSegment
decodePathSegment = fromString . UE.decode . Text.unpack

normalizeUnicode :: Text -> Text
normalizeUnicode = UT.normalize UT.NFC