espial-0.0.9: src/PathPiece.hs

{-# OPTIONS_GHC -fno-warn-orphans #-}

module PathPiece where
  
import Data.Text (breakOn, splitOn)
import qualified Data.Text as T (replace)
import Import.NoFoundation

-- PathPiece

instance PathPiece UserNameP where
  toPathPiece (UserNameP i) = "u:" <> i
  fromPathPiece s =
    case breakOn ":" s of
      ("u", "") -> Nothing
      ("u", uname) -> Just $ UserNameP (drop 1 uname)
      _ -> Nothing

instance PathPiece TagsP where
  toPathPiece (TagsP tags) = "t:" <> intercalate "+" (fmap encodeTag tags)
  fromPathPiece s =
    case breakOn ":" s of
      ("t", "") -> Nothing
      ("t", tags) -> Just $ (TagsP . fmap decodeTag . splitOn "+" . drop 1) tags
      _ -> Nothing

encodeTag :: Text -> Text
encodeTag = T.replace "+" "%2B"

decodeTag :: Text -> Text
decodeTag = T.replace "%2B" "+"

instance PathPiece SharedP where
  toPathPiece = \case
    SharedAll -> ""
    SharedPublic -> "public"
    SharedPrivate -> "private"
  fromPathPiece = \case
    "public" -> Just SharedPublic
    "private" -> Just SharedPrivate
    _ -> Nothing

instance PathPiece FilterP where
  toPathPiece = \case
    FilterAll -> ""
    FilterUnread -> "unread"
    FilterUntagged -> "untagged"
    FilterStarred -> "starred"
    FilterSingle slug -> "b:" <> unBmSlug slug
  fromPathPiece = \case
    "unread" -> Just FilterUnread
    "untagged" -> Just FilterUntagged
    "starred" -> Just FilterStarred
    s -> case breakOn ":" s of
        ("b", "") -> Nothing
        ("b", slug) -> Just $ FilterSingle (BmSlug (drop 1 slug))
        _ -> Nothing


deriving instance PathPiece NtSlug 
deriving instance PathPiece BmSlug