    {-# LANGUAGE CPP #-}
    {-# LANGUAGE DeriveGeneric #-}
    {-# LANGUAGE DeriveAnyClass #-}
    {-# LANGUAGE OverloadedStrings #-}
    {-# LANGUAGE RecordWildCards #-}
    module Hpack.Syntax.Defaults (
      Defaults(..)
    , Github(..)
    , Local(..)
    #ifdef TEST
    , isValidOwner
    , isValidRepo
    #endif
    ) where

    import           Imports

    import           Data.Aeson.Config.KeyMap (member)
    import qualified Data.Text as T
    import           System.FilePath.Posix (splitDirectories)

    import           Data.Aeson.Config.FromValue
    import           Hpack.Syntax.Git

    data ParseGithub = ParseGithub {
      ParseGithub -> GithubRepo
    parseGithubGithub :: GithubRepo
    , ParseGithub -> Ref
    parseGithubRef :: Ref
    , ParseGithub -> Maybe Path
    parseGithubPath :: Maybe Path
    } deriving ((forall x. ParseGithub -> Rep ParseGithub x)
    -> (forall x. Rep ParseGithub x -> ParseGithub)
    -> Generic ParseGithub
    forall x. Rep ParseGithub x -> ParseGithub
    forall x. ParseGithub -> Rep ParseGithub x
    forall a.
    (forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
    $cfrom :: forall x. ParseGithub -> Rep ParseGithub x
    from :: forall x. ParseGithub -> Rep ParseGithub x
    $cto :: forall x. Rep ParseGithub x -> ParseGithub
    to :: forall x. Rep ParseGithub x -> ParseGithub
    Generic, Value -> Parser ParseGithub
    (Value -> Parser ParseGithub) -> FromValue ParseGithub
    forall a. (Value -> Parser a) -> FromValue a
    $cfromValue :: Value -> Parser ParseGithub
    fromValue :: Value -> Parser ParseGithub
    FromValue)

    data GithubRepo = GithubRepo {
      GithubRepo -> [Char]
    githubRepoOwner :: String
    , GithubRepo -> [Char]
    githubRepoName :: String
    }

    instance FromValue GithubRepo where
      fromValue :: Value -> Parser GithubRepo
    fromValue = ([Char] -> Parser GithubRepo) -> Value -> Parser GithubRepo
    forall a. ([Char] -> Parser a) -> Value -> Parser a
    withString [Char] -> Parser GithubRepo
    parseGithub

    parseGithub :: String -> Parser GithubRepo
    parseGithub :: [Char] -> Parser GithubRepo
    parseGithub [Char]
    github
      | Bool -> Bool
    not ([Char] -> Bool
    isValidOwner [Char]
    owner) = [Char] -> Parser GithubRepo
    forall a. [Char] -> Parser a
    forall (m :: * -> *) a. MonadFail m => [Char] -> m a
    fail ([Char]
    "invalid owner name " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char] -> [Char]
    forall a. Show a => a -> [Char]
    show [Char]
    owner)
      | Bool -> Bool
    not ([Char] -> Bool
    isValidRepo [Char]
    repo) = [Char] -> Parser GithubRepo
    forall a. [Char] -> Parser a
    forall (m :: * -> *) a. MonadFail m => [Char] -> m a
    fail ([Char]
    "invalid repository name " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char] -> [Char]
    forall a. Show a => a -> [Char]
    show [Char]
    repo)
      | Bool
    otherwise = GithubRepo -> Parser GithubRepo
    forall a. a -> Parser a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ([Char] -> [Char] -> GithubRepo
    GithubRepo [Char]
    owner [Char]
    repo)
      where
        ([Char]
    owner, [Char]
    repo) = Int -> [Char] -> [Char]
    forall a. Int -> [a] -> [a]
    drop Int
    1 ([Char] -> [Char]) -> ([Char], [Char]) -> ([Char], [Char])
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> (Char -> Bool) -> [Char] -> ([Char], [Char])
    forall a. (a -> Bool) -> [a] -> ([a], [a])
    break (Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    == Char
    '/') [Char]
    github

    isValidOwner :: String -> Bool
    isValidOwner :: [Char] -> Bool
    isValidOwner [Char]
    owner =
         Bool -> Bool
    not ([Char] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [Char]
    owner)
      Bool -> Bool -> Bool
    && (Char -> Bool) -> [Char] -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    all Char -> Bool
    isAlphaNumOrHyphen [Char]
    owner
      Bool -> Bool -> Bool
    && [Char] -> Bool
    doesNotHaveConsecutiveHyphens [Char]
    owner
      Bool -> Bool -> Bool
    && [Char] -> Bool
    doesNotBeginWithHyphen [Char]
    owner
      Bool -> Bool -> Bool
    && [Char] -> Bool
    doesNotEndWithHyphen [Char]
    owner
      where
        isAlphaNumOrHyphen :: Char -> Bool
    isAlphaNumOrHyphen = (Char -> [Char] -> Bool
    forall a. Eq a => a -> [a] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` Char
    '-' Char -> [Char] -> [Char]
    forall a. a -> [a] -> [a]
    : [Char]
    alphaNum)
        doesNotHaveConsecutiveHyphens :: [Char] -> Bool
    doesNotHaveConsecutiveHyphens = Bool -> Bool
    not (Bool -> Bool) -> ([Char] -> Bool) -> [Char] -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [Char] -> [Char] -> Bool
    forall a. Eq a => [a] -> [a] -> Bool
    isInfixOf [Char]
    "--"
        doesNotBeginWithHyphen :: [Char] -> Bool
    doesNotBeginWithHyphen = Bool -> Bool
    not (Bool -> Bool) -> ([Char] -> Bool) -> [Char] -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [Char] -> [Char] -> Bool
    forall a. Eq a => [a] -> [a] -> Bool
    isPrefixOf [Char]
    "-"
        doesNotEndWithHyphen :: [Char] -> Bool
    doesNotEndWithHyphen = Bool -> Bool
    not (Bool -> Bool) -> ([Char] -> Bool) -> [Char] -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [Char] -> [Char] -> Bool
    forall a. Eq a => [a] -> [a] -> Bool
    isSuffixOf [Char]
    "-"

    isValidRepo :: String -> Bool
    isValidRepo :: [Char] -> Bool
    isValidRepo [Char]
    repo =
         Bool -> Bool
    not ([Char] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [Char]
    repo)
      Bool -> Bool -> Bool
    && [Char]
    repo [Char] -> [[Char]] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `notElem` [[Char]
    ".", [Char]
    ".."]
      Bool -> Bool -> Bool
    && (Char -> Bool) -> [Char] -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    all Char -> Bool
    isValid [Char]
    repo
      where
        isValid :: Char -> Bool
    isValid = (Char -> [Char] -> Bool
    forall a. Eq a => a -> [a] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` Char
    '_' Char -> [Char] -> [Char]
    forall a. a -> [a] -> [a]
    : Char
    '.' Char -> [Char] -> [Char]
    forall a. a -> [a] -> [a]
    : Char
    '-' Char -> [Char] -> [Char]
    forall a. a -> [a] -> [a]
    : [Char]
    alphaNum)

    alphaNum :: [Char]
    alphaNum :: [Char]
    alphaNum = [Char
    'a'..Char
    'z'] [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char
    'A'..Char
    'Z'] [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char
    '0'..Char
    '9']

    data Ref = Ref {Ref -> [Char]
    unRef :: String}

    instance FromValue Ref where
      fromValue :: Value -> Parser Ref
    fromValue = ([Char] -> Parser Ref) -> Value -> Parser Ref
    forall a. ([Char] -> Parser a) -> Value -> Parser a
    withString [Char] -> Parser Ref
    parseRef

    parseRef :: String -> Parser Ref
    parseRef :: [Char] -> Parser Ref
    parseRef [Char]
    ref
      | [Char] -> Bool
    isValidRef [Char]
    ref = Ref -> Parser Ref
    forall a. a -> Parser a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ([Char] -> Ref
    Ref [Char]
    ref)
      | Bool
    otherwise = [Char] -> Parser Ref
    forall a. [Char] -> Parser a
    forall (m :: * -> *) a. MonadFail m => [Char] -> m a
    fail ([Char]
    "invalid Git reference " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char] -> [Char]
    forall a. Show a => a -> [Char]
    show [Char]
    ref)

    data Path = Path {Path -> [[Char]]
    unPath :: [FilePath]}

    instance FromValue Path where
      fromValue :: Value -> Parser Path
    fromValue = ([Char] -> Parser Path) -> Value -> Parser Path
    forall a. ([Char] -> Parser a) -> Value -> Parser a
    withString [Char] -> Parser Path
    parsePath

    parsePath :: String -> Parser Path
    parsePath :: [Char] -> Parser Path
    parsePath [Char]
    path
      | Char
    '\\' Char -> [Char] -> Bool
    forall a. Eq a => a -> [a] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` [Char]
    path = [Char] -> Parser Path
    forall a. [Char] -> Parser a
    forall (m :: * -> *) a. MonadFail m => [Char] -> m a
    fail ([Char]
    "rejecting '\\' in " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char] -> [Char]
    forall a. Show a => a -> [Char]
    show [Char]
    path [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    ", please use '/' to separate path components")
      | Char
    ':' Char -> [Char] -> Bool
    forall a. Eq a => a -> [a] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` [Char]
    path = [Char] -> Parser Path
    forall a. [Char] -> Parser a
    forall (m :: * -> *) a. MonadFail m => [Char] -> m a
    fail ([Char]
    "rejecting ':' in " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char] -> [Char]
    forall a. Show a => a -> [Char]
    show [Char]
    path)
      | [Char]
    "/" [Char] -> [[Char]] -> Bool
    forall a. Eq a => a -> [a] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` [[Char]]
    p = [Char] -> Parser Path
    forall a. [Char] -> Parser a
    forall (m :: * -> *) a. MonadFail m => [Char] -> m a
    fail ([Char]
    "rejecting absolute path " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char] -> [Char]
    forall a. Show a => a -> [Char]
    show [Char]
    path)
      | [Char]
    ".." [Char] -> [[Char]] -> Bool
    forall a. Eq a => a -> [a] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` [[Char]]
    p = [Char] -> Parser Path
    forall a. [Char] -> Parser a
    forall (m :: * -> *) a. MonadFail m => [Char] -> m a
    fail ([Char]
    "rejecting \"..\" in " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char] -> [Char]
    forall a. Show a => a -> [Char]
    show [Char]
    path)
      | Bool
    otherwise = Path -> Parser Path
    forall a. a -> Parser a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ([[Char]] -> Path
    Path [[Char]]
    p)
      where
        p :: [[Char]]
    p = [Char] -> [[Char]]
    splitDirectories [Char]
    path

    data Github = Github {
      Github -> [Char]
    githubOwner :: String
    , Github -> [Char]
    githubRepo :: String
    , Github -> [Char]
    githubRef :: String
    , Github -> [[Char]]
    githubPath :: [FilePath]
    } deriving (Github -> Github -> Bool
    (Github -> Github -> Bool)
    -> (Github -> Github -> Bool) -> Eq Github
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: Github -> Github -> Bool
    == :: Github -> Github -> Bool
    $c/= :: Github -> Github -> Bool
    /= :: Github -> Github -> Bool
    Eq, Int -> Github -> [Char] -> [Char]
    [Github] -> [Char] -> [Char]
    Github -> [Char]
    (Int -> Github -> [Char] -> [Char])
    -> (Github -> [Char])
    -> ([Github] -> [Char] -> [Char])
    -> Show Github
    forall a.
    (Int -> a -> [Char] -> [Char])
    -> (a -> [Char]) -> ([a] -> [Char] -> [Char]) -> Show a
    $cshowsPrec :: Int -> Github -> [Char] -> [Char]
    showsPrec :: Int -> Github -> [Char] -> [Char]
    $cshow :: Github -> [Char]
    show :: Github -> [Char]
    $cshowList :: [Github] -> [Char] -> [Char]
    showList :: [Github] -> [Char] -> [Char]
    Show)

    toDefaultsGithub :: ParseGithub -> Github
    toDefaultsGithub :: ParseGithub -> Github
    toDefaultsGithub ParseGithub{Maybe Path
    Ref
    GithubRepo
    parseGithubGithub :: ParseGithub -> GithubRepo
    parseGithubRef :: ParseGithub -> Ref
    parseGithubPath :: ParseGithub -> Maybe Path
    parseGithubGithub :: GithubRepo
    parseGithubRef :: Ref
    parseGithubPath :: Maybe Path
    ..} = Github {
        githubOwner :: [Char]
    githubOwner = GithubRepo -> [Char]
    githubRepoOwner GithubRepo
    parseGithubGithub
      , githubRepo :: [Char]
    githubRepo = GithubRepo -> [Char]
    githubRepoName GithubRepo
    parseGithubGithub
      , githubRef :: [Char]
    githubRef = Ref -> [Char]
    unRef Ref
    parseGithubRef
      , githubPath :: [[Char]]
    githubPath = [[Char]] -> (Path -> [[Char]]) -> Maybe Path -> [[Char]]
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe [[Char]
    ".hpack", [Char]
    "defaults.yaml"] Path -> [[Char]]
    unPath Maybe Path
    parseGithubPath
      }

    parseDefaultsGithubFromString :: String -> Parser ParseGithub
    parseDefaultsGithubFromString :: [Char] -> Parser ParseGithub
    parseDefaultsGithubFromString [Char]
    xs = case (Char -> Bool) -> [Char] -> ([Char], [Char])
    forall a. (a -> Bool) -> [a] -> ([a], [a])
    break (Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    == Char
    '@') [Char]
    xs of
      ([Char]
    github, Char
    '@' : [Char]
    ref) -> GithubRepo -> Ref -> Maybe Path -> ParseGithub
    ParseGithub (GithubRepo -> Ref -> Maybe Path -> ParseGithub)
    -> Parser GithubRepo -> Parser (Ref -> Maybe Path -> ParseGithub)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> [Char] -> Parser GithubRepo
    parseGithub [Char]
    github Parser (Ref -> Maybe Path -> ParseGithub)
    -> Parser Ref -> Parser (Maybe Path -> ParseGithub)
    forall a b. Parser (a -> b) -> Parser a -> Parser b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> [Char] -> Parser Ref
    parseRef [Char]
    ref Parser (Maybe Path -> ParseGithub)
    -> Parser (Maybe Path) -> Parser ParseGithub
    forall a b. Parser (a -> b) -> Parser a -> Parser b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> Maybe Path -> Parser (Maybe Path)
    forall a. a -> Parser a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Maybe Path
    forall a. Maybe a
    Nothing
      ([Char], [Char])
    _ -> [Char] -> Parser ParseGithub
    forall a. [Char] -> Parser a
    forall (m :: * -> *) a. MonadFail m => [Char] -> m a
    fail ([Char]
    "missing Git reference for " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char] -> [Char]
    forall a. Show a => a -> [Char]
    show [Char]
    xs [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    ", the expected format is owner/repo@ref")

    data Local = Local {
      Local -> [Char]
    localLocal :: String
    } deriving (Local -> Local -> Bool
    (Local -> Local -> Bool) -> (Local -> Local -> Bool) -> Eq Local
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: Local -> Local -> Bool
    == :: Local -> Local -> Bool
    $c/= :: Local -> Local -> Bool
    /= :: Local -> Local -> Bool
    Eq, Int -> Local -> [Char] -> [Char]
    [Local] -> [Char] -> [Char]
    Local -> [Char]
    (Int -> Local -> [Char] -> [Char])
    -> (Local -> [Char]) -> ([Local] -> [Char] -> [Char]) -> Show Local
    forall a.
    (Int -> a -> [Char] -> [Char])
    -> (a -> [Char]) -> ([a] -> [Char] -> [Char]) -> Show a
    $cshowsPrec :: Int -> Local -> [Char] -> [Char]
    showsPrec :: Int -> Local -> [Char] -> [Char]
    $cshow :: Local -> [Char]
    show :: Local -> [Char]
    $cshowList :: [Local] -> [Char] -> [Char]
    showList :: [Local] -> [Char] -> [Char]
    Show, (forall x. Local -> Rep Local x)
    -> (forall x. Rep Local x -> Local) -> Generic Local
    forall x. Rep Local x -> Local
    forall x. Local -> Rep Local x
    forall a.
    (forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
    $cfrom :: forall x. Local -> Rep Local x
    from :: forall x. Local -> Rep Local x
    $cto :: forall x. Rep Local x -> Local
    to :: forall x. Rep Local x -> Local
    Generic, Value -> Parser Local
    (Value -> Parser Local) -> FromValue Local
    forall a. (Value -> Parser a) -> FromValue a
    $cfromValue :: Value -> Parser Local
    fromValue :: Value -> Parser Local
    FromValue)

    data Defaults = DefaultsLocal Local | DefaultsGithub Github
      deriving (Defaults -> Defaults -> Bool
    (Defaults -> Defaults -> Bool)
    -> (Defaults -> Defaults -> Bool) -> Eq Defaults
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: Defaults -> Defaults -> Bool
    == :: Defaults -> Defaults -> Bool
    $c/= :: Defaults -> Defaults -> Bool
    /= :: Defaults -> Defaults -> Bool
    Eq, Int -> Defaults -> [Char] -> [Char]
    [Defaults] -> [Char] -> [Char]
    Defaults -> [Char]
    (Int -> Defaults -> [Char] -> [Char])
    -> (Defaults -> [Char])
    -> ([Defaults] -> [Char] -> [Char])
    -> Show Defaults
    forall a.
    (Int -> a -> [Char] -> [Char])
    -> (a -> [Char]) -> ([a] -> [Char] -> [Char]) -> Show a
    $cshowsPrec :: Int -> Defaults -> [Char] -> [Char]
    showsPrec :: Int -> Defaults -> [Char] -> [Char]
    $cshow :: Defaults -> [Char]
    show :: Defaults -> [Char]
    $cshowList :: [Defaults] -> [Char] -> [Char]
    showList :: [Defaults] -> [Char] -> [Char]
    Show)

    instance FromValue Defaults where
      fromValue :: Value -> Parser Defaults
    fromValue Value
    v = case Value
    v of
        String Text
    s -> Github -> Defaults
    DefaultsGithub (Github -> Defaults)
    -> (ParseGithub -> Github) -> ParseGithub -> Defaults
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ParseGithub -> Github
    toDefaultsGithub (ParseGithub -> Defaults) -> Parser ParseGithub -> Parser Defaults
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> [Char] -> Parser ParseGithub
    parseDefaultsGithubFromString (Text -> [Char]
    T.unpack Text
    s)
        Object Object
    o | Key
    "local" Key -> Object -> Bool
    forall a. Key -> KeyMap a -> Bool
    `member` Object
    o -> Local -> Defaults
    DefaultsLocal (Local -> Defaults) -> Parser Local -> Parser Defaults
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Value -> Parser Local
    forall a. FromValue a => Value -> Parser a
    fromValue Value
    v
        Object Object
    o | Key
    "github" Key -> Object -> Bool
    forall a. Key -> KeyMap a -> Bool
    `member` Object
    o -> Github -> Defaults
    DefaultsGithub (Github -> Defaults)
    -> (ParseGithub -> Github) -> ParseGithub -> Defaults
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ParseGithub -> Github
    toDefaultsGithub (ParseGithub -> Defaults) -> Parser ParseGithub -> Parser Defaults
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Value -> Parser ParseGithub
    forall a. FromValue a => Value -> Parser a
    fromValue Value
    v
        Object Object
    _ -> [Char] -> Parser Defaults
    forall a. [Char] -> Parser a
    forall (m :: * -> *) a. MonadFail m => [Char] -> m a
    fail [Char]
    "neither key \"github\" nor key \"local\" present"
        Value
    _ -> [Char] -> Value -> Parser Defaults
    forall a. [Char] -> Value -> Parser a
    typeMismatch [Char]
    "Object or String" Value
    v