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

    import           Data.HashMap.Lazy (member)
    import           Data.List
    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
    $cto :: forall x. Rep ParseGithub x -> ParseGithub
    $cfrom :: forall x. ParseGithub -> Rep ParseGithub x
    Generic, Value -> Parser ParseGithub
    (Value -> Parser ParseGithub) -> FromValue ParseGithub
    forall a. (Value -> Parser a) -> FromValue a
    fromValue :: Value -> Parser ParseGithub
    $cfromValue :: Value -> Parser ParseGithub
    FromValue)

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

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

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

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

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

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

    data Ref = Ref {Ref -> String
    unRef :: String}

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

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

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

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

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

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

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

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

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

    instance FromValue Defaults where
      fromValue :: Value -> Parser Defaults
    fromValue v :: Value
    v = case Value
    v of
        String s :: 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
    <$> String -> Parser ParseGithub
    parseDefaultsGithubFromString (Text -> String
    T.unpack Text
    s)
        Object o :: Object
    o | "local" Text -> Object -> Bool
    forall k a. (Eq k, Hashable k) => k -> HashMap k 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 o :: Object
    o | "github" Text -> Object -> Bool
    forall k a. (Eq k, Hashable k) => k -> HashMap k 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 _ -> String -> Parser Defaults
    forall (m :: * -> *) a. MonadFail m => String -> m a
    fail "neither key \"github\" nor key \"local\" present"
        _ -> String -> Value -> Parser Defaults
    forall a. String -> Value -> Parser a
    typeMismatch "Object or String" Value
    v