{-# LANGUAGE DeriveGeneric #-}
module Distribution.Client.Types.RepoName (
    RepoName (..),
) where

import Distribution.Client.Compat.Prelude
import Prelude ()

import qualified Distribution.Compat.CharParsing as P
import qualified Text.PrettyPrint                as Disp

-- $setup
-- >>> import Distribution.Parsec

-- | Repository name.
--
-- May be used as path segment.
--
newtype RepoName = RepoName { RepoName -> String
unRepoName :: String }
  deriving (Int -> RepoName -> ShowS
[RepoName] -> ShowS
RepoName -> String
(Int -> RepoName -> ShowS)
-> (RepoName -> String) -> ([RepoName] -> ShowS) -> Show RepoName
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RepoName] -> ShowS
$cshowList :: [RepoName] -> ShowS
show :: RepoName -> String
$cshow :: RepoName -> String
showsPrec :: Int -> RepoName -> ShowS
$cshowsPrec :: Int -> RepoName -> ShowS
Show, RepoName -> RepoName -> Bool
(RepoName -> RepoName -> Bool)
-> (RepoName -> RepoName -> Bool) -> Eq RepoName
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RepoName -> RepoName -> Bool
$c/= :: RepoName -> RepoName -> Bool
== :: RepoName -> RepoName -> Bool
$c== :: RepoName -> RepoName -> Bool
Eq, Eq RepoName
Eq RepoName
-> (RepoName -> RepoName -> Ordering)
-> (RepoName -> RepoName -> Bool)
-> (RepoName -> RepoName -> Bool)
-> (RepoName -> RepoName -> Bool)
-> (RepoName -> RepoName -> Bool)
-> (RepoName -> RepoName -> RepoName)
-> (RepoName -> RepoName -> RepoName)
-> Ord RepoName
RepoName -> RepoName -> Bool
RepoName -> RepoName -> Ordering
RepoName -> RepoName -> RepoName
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: RepoName -> RepoName -> RepoName
$cmin :: RepoName -> RepoName -> RepoName
max :: RepoName -> RepoName -> RepoName
$cmax :: RepoName -> RepoName -> RepoName
>= :: RepoName -> RepoName -> Bool
$c>= :: RepoName -> RepoName -> Bool
> :: RepoName -> RepoName -> Bool
$c> :: RepoName -> RepoName -> Bool
<= :: RepoName -> RepoName -> Bool
$c<= :: RepoName -> RepoName -> Bool
< :: RepoName -> RepoName -> Bool
$c< :: RepoName -> RepoName -> Bool
compare :: RepoName -> RepoName -> Ordering
$ccompare :: RepoName -> RepoName -> Ordering
$cp1Ord :: Eq RepoName
Ord, (forall x. RepoName -> Rep RepoName x)
-> (forall x. Rep RepoName x -> RepoName) -> Generic RepoName
forall x. Rep RepoName x -> RepoName
forall x. RepoName -> Rep RepoName x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep RepoName x -> RepoName
$cfrom :: forall x. RepoName -> Rep RepoName x
Generic)

instance Binary RepoName
instance Structured RepoName
instance NFData RepoName

instance Pretty RepoName where
    pretty :: RepoName -> Doc
pretty = String -> Doc
Disp.text (String -> Doc) -> (RepoName -> String) -> RepoName -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RepoName -> String
unRepoName

-- |
--
-- >>> simpleParsec "hackage.haskell.org" :: Maybe RepoName
-- Just (RepoName "hackage.haskell.org")
--
-- >>> simpleParsec "0123" :: Maybe RepoName
-- Nothing
--
instance Parsec RepoName where
    parsec :: m RepoName
parsec = String -> RepoName
RepoName (String -> RepoName) -> m String -> m RepoName
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m String
parser where
        parser :: m String
parser = (:) (Char -> ShowS) -> m Char -> m ShowS
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m Char
lead m ShowS -> m String -> m String
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> m String
rest
        lead :: m Char
lead = (Char -> Bool) -> m Char
forall (m :: * -> *). CharParsing m => (Char -> Bool) -> m Char
P.satisfy (\Char
c -> Char -> Bool
isAlpha    Char
c Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'_' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'-' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'.')
        rest :: m String
rest = (Char -> Bool) -> m String
forall (m :: * -> *). CharParsing m => (Char -> Bool) -> m String
P.munch   (\Char
c -> Char -> Bool
isAlphaNum Char
c Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'_' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'-' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'.')