{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE DisambiguateRecordFields #-}
{-# LANGUAGE OverloadedStrings #-}

-- | Duplicates a subset of the Stack ADT. It'd be nice if we could just re-use
-- the actual ADT, but stack isn't available as a library that we can build from
-- Hackage.
module StackageToHackage.Stackage where

import StackageToHackage.Stackage.Types
import StackageToHackage.Stackage.YAML ()

import Control.Applicative ((<|>))
import Control.Monad.Extra (loopM, unlessM)
import Data.ByteString.Lazy (toStrict)
import Data.List (nub, foldl', find, (\\))
import Data.List.NonEmpty (NonEmpty(..), head, nonEmpty, reverse, (<|))
import Data.Maybe (fromMaybe, listToMaybe, mapMaybe)
import Data.Semigroup
import Data.Text (Text, replace, unpack, isPrefixOf)
import Data.YAML (FromYAML, decodeStrict)
import Network.HTTP.Client (httpLbs, parseRequest, responseBody)
import Network.HTTP.Client.TLS (getGlobalManager)
import Prelude hiding (head, reverse, takeWhile)
import System.Directory
    (XdgDirectory(..), createDirectoryIfMissing, doesFileExist, getXdgDirectory)
import System.FilePath (takeDirectory, (</>))
import System.IO (stderr, hPutStrLn)

import qualified Data.ByteString as BS


localDirs :: Stack -> NonEmpty FilePath
localDirs :: Stack -> NonEmpty FilePath
localDirs Stack { [Package]
$sel:packages:Stack :: Stack -> [Package]
packages :: [Package]
packages } = NonEmpty FilePath -> Maybe (NonEmpty FilePath) -> NonEmpty FilePath
forall a. a -> Maybe a -> a
fromMaybe (FilePath -> NonEmpty FilePath
forall (f :: * -> *) a. Applicative f => a -> f a
pure FilePath
".") (Maybe (NonEmpty FilePath) -> NonEmpty FilePath)
-> Maybe (NonEmpty FilePath) -> NonEmpty FilePath
forall a b. (a -> b) -> a -> b
$ [FilePath] -> Maybe (NonEmpty FilePath)
forall a. [a] -> Maybe (NonEmpty a)
nonEmpty ([FilePath] -> Maybe (NonEmpty FilePath))
-> [FilePath] -> Maybe (NonEmpty FilePath)
forall a b. (a -> b) -> a -> b
$ (Package -> Maybe FilePath) -> [Package] -> [FilePath]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe
    Package -> Maybe FilePath
locals
    [Package]
packages
  where
    locals :: Package -> Maybe FilePath
locals (Local FilePath
p) = FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just FilePath
p
    locals (Location Git
_) = Maybe FilePath
forall a. Maybe a
Nothing

--------------------------------------------------------------------------------
-- Resolvers

readStack :: BS.ByteString -> IO Stack
readStack :: ByteString -> IO Stack
readStack ByteString
text = (FilePath -> IO Stack)
-> (Stack -> IO Stack) -> Either FilePath Stack -> IO Stack
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either FilePath -> IO Stack
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail Stack -> IO Stack
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either FilePath Stack -> IO Stack)
-> Either FilePath Stack -> IO Stack
forall a b. (a -> b) -> a -> b
$ ByteString -> Either FilePath Stack
forall a. FromYAML a => ByteString -> Either FilePath a
decode1Strict ByteString
text


-- highest priority resolver first
unroll :: FilePath -> Stack -> IO Resolvers
unroll :: FilePath -> Stack -> IO Resolvers
unroll FilePath
base Stack
stack = do
    let stack' :: Resolver
stack' = Stack -> Resolver
stack2resolver Stack
stack
    Resolvers -> Resolvers
forall a. NonEmpty a -> NonEmpty a
reverse (Resolvers -> Resolvers) -> IO Resolvers -> IO Resolvers
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (RelativeResolvers -> IO (Either RelativeResolvers Resolvers))
-> RelativeResolvers -> IO Resolvers
forall (m :: * -> *) a b.
Monad m =>
(a -> m (Either a b)) -> a -> m b
loopM RelativeResolvers -> IO (Either RelativeResolvers Resolvers)
next ((Maybe FilePath, Resolver) -> RelativeResolvers
forall (f :: * -> *) a. Applicative f => a -> f a
pure (FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just FilePath
base, Resolver
stack'))
  where
    -- lowest priority (deepest) resolver first
    next :: RelativeResolvers -> IO (Either RelativeResolvers Resolvers)
    next :: RelativeResolvers -> IO (Either RelativeResolvers Resolvers)
next RelativeResolvers
rs = case RelativeResolvers -> (Maybe FilePath, Resolver)
forall a. NonEmpty a -> a
head RelativeResolvers
rs of
        (Maybe FilePath
_, Resolver Maybe ResolverRef
Nothing Maybe Ghc
_ [Dep]
_ Flags
_) -> Either RelativeResolvers Resolvers
-> IO (Either RelativeResolvers Resolvers)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either RelativeResolvers Resolvers
 -> IO (Either RelativeResolvers Resolvers))
-> Either RelativeResolvers Resolvers
-> IO (Either RelativeResolvers Resolvers)
forall a b. (a -> b) -> a -> b
$ Resolvers -> Either RelativeResolvers Resolvers
forall a b. b -> Either a b
Right ((Maybe FilePath, Resolver) -> Resolver
forall a b. (a, b) -> b
snd ((Maybe FilePath, Resolver) -> Resolver)
-> RelativeResolvers -> Resolvers
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RelativeResolvers
rs)
        (Maybe FilePath
dir, Resolver (Just ResolverRef
r) Maybe Ghc
_ [Dep]
_ Flags
_) -> RelativeResolvers -> Either RelativeResolvers Resolvers
forall a b. a -> Either a b
Left (RelativeResolvers -> Either RelativeResolvers Resolvers)
-> ((Maybe FilePath, Resolver) -> RelativeResolvers)
-> (Maybe FilePath, Resolver)
-> Either RelativeResolvers Resolvers
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Maybe FilePath, Resolver)
-> RelativeResolvers -> RelativeResolvers
forall a. a -> NonEmpty a -> NonEmpty a
<| RelativeResolvers
rs) ((Maybe FilePath, Resolver) -> Either RelativeResolvers Resolvers)
-> IO (Maybe FilePath, Resolver)
-> IO (Either RelativeResolvers Resolvers)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe FilePath -> ResolverRef -> IO (Maybe FilePath, Resolver)
resolve Maybe FilePath
dir ResolverRef
r


-- if the Resolver is a local snapshot, also include its dir
resolve :: Maybe FilePath -> ResolverRef -> IO (Maybe FilePath, Resolver)
resolve :: Maybe FilePath -> ResolverRef -> IO (Maybe FilePath, Resolver)
resolve Maybe FilePath
_ (Canned Text
lts) = do
    FilePath
cached <- Text -> IO FilePath
cache Text
lts
    ByteString
text <- FilePath -> IO ByteString
BS.readFile FilePath
cached IO ByteString -> IO ByteString -> IO ByteString
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> IO ByteString
download
    FilePath -> ByteString -> IO ()
update FilePath
cached ByteString
text
    (FilePath -> IO (Maybe FilePath, Resolver))
-> (Resolver -> IO (Maybe FilePath, Resolver))
-> Either FilePath Resolver
-> IO (Maybe FilePath, Resolver)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either FilePath -> IO (Maybe FilePath, Resolver)
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail (\Resolver
r -> (Maybe FilePath, Resolver) -> IO (Maybe FilePath, Resolver)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe FilePath
forall a. Maybe a
Nothing, Resolver
r)) (Either FilePath Resolver -> IO (Maybe FilePath, Resolver))
-> Either FilePath Resolver -> IO (Maybe FilePath, Resolver)
forall a b. (a -> b) -> a -> b
$ NewResolver -> Resolver
new2old (NewResolver -> Resolver)
-> Either FilePath NewResolver -> Either FilePath Resolver
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ByteString -> Either FilePath NewResolver
forall a. FromYAML a => ByteString -> Either FilePath a
decode1Strict ByteString
text
  where
    download :: IO ByteString
download =
        let path :: FilePath
path = Text -> FilePath
unpack
                (Text -> FilePath) -> Text -> FilePath
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Text -> Text
replace Text
"." Text
"/" (Text -> Text -> Text -> Text
replace Text
"-" Text
"/" (Text -> Text -> Text -> Text
replace Text
"-0" Text
"-" Text
lts))
            raw :: FilePath
raw = [FilePath] -> FilePath
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
                [ FilePath
"https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/"
                , FilePath
path, FilePath
".yaml"
                ]
        in do
            Manager
manager <- IO Manager
getGlobalManager
            Request
url <- FilePath -> IO Request
forall (m :: * -> *). MonadThrow m => FilePath -> m Request
parseRequest FilePath
raw
            Handle -> FilePath -> IO ()
hPutStrLn Handle
stderr (FilePath
"Downloading: " FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
raw)
            Response ByteString
resp <- Request -> Manager -> IO (Response ByteString)
httpLbs Request
url Manager
manager
            ByteString -> IO ByteString
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ByteString -> IO ByteString) -> ByteString -> IO ByteString
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
toStrict (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ Response ByteString -> ByteString
forall body. Response body -> body
responseBody Response ByteString
resp

    update :: FilePath -> ByteString -> IO ()
update FilePath
file ByteString
content =
        IO Bool -> IO () -> IO ()
forall (m :: * -> *). Monad m => m Bool -> m () -> m ()
unlessM (FilePath -> IO Bool
doesFileExist FilePath
file) (FilePath -> ByteString -> IO ()
BS.writeFile FilePath
file ByteString
content)

resolve (Just FilePath
base) (Snapshot Text
path)
    | Text -> Text -> Bool
isPrefixOf Text
"http://" Text
path Bool -> Bool -> Bool
|| Text -> Text -> Bool
isPrefixOf Text
"https://" Text
path = IO (Maybe FilePath, Resolver)
forall a. IO (Maybe a, Resolver)
parseFromURL
    | Bool
otherwise = IO (Maybe FilePath, Resolver)
parseFromFile
  where
    parseFromFile :: IO (Maybe FilePath, Resolver)
parseFromFile = do
        let file :: FilePath
file = FilePath
base FilePath -> FilePath -> FilePath
</> Text -> FilePath
unpack Text
path
            dir :: FilePath
dir = FilePath -> FilePath
takeDirectory FilePath
file
        ByteString
text <- FilePath -> IO ByteString
BS.readFile FilePath
file
        (FilePath -> IO (Maybe FilePath, Resolver))
-> (Resolver -> IO (Maybe FilePath, Resolver))
-> Either FilePath Resolver
-> IO (Maybe FilePath, Resolver)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either FilePath -> IO (Maybe FilePath, Resolver)
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail (\Resolver
r -> (Maybe FilePath, Resolver) -> IO (Maybe FilePath, Resolver)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just FilePath
dir, Resolver
r)) (Either FilePath Resolver -> IO (Maybe FilePath, Resolver))
-> Either FilePath Resolver -> IO (Maybe FilePath, Resolver)
forall a b. (a -> b) -> a -> b
$ ByteString -> Either FilePath Resolver
forall a. FromYAML a => ByteString -> Either FilePath a
decode1Strict ByteString
text
    parseFromURL :: IO (Maybe a, Resolver)
parseFromURL = do
        ByteString
text <- IO ByteString
download
        (FilePath -> IO (Maybe a, Resolver))
-> (Resolver -> IO (Maybe a, Resolver))
-> Either FilePath Resolver
-> IO (Maybe a, Resolver)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either FilePath -> IO (Maybe a, Resolver)
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail (\Resolver
r -> (Maybe a, Resolver) -> IO (Maybe a, Resolver)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe a
forall a. Maybe a
Nothing, Resolver
r)) (Either FilePath Resolver -> IO (Maybe a, Resolver))
-> Either FilePath Resolver -> IO (Maybe a, Resolver)
forall a b. (a -> b) -> a -> b
$ ByteString -> Either FilePath Resolver
forall a. FromYAML a => ByteString -> Either FilePath a
decode1Strict ByteString
text
    download :: IO ByteString
download = do
        Manager
manager <- IO Manager
getGlobalManager
        Request
url <- FilePath -> IO Request
forall (m :: * -> *). MonadThrow m => FilePath -> m Request
parseRequest (Text -> FilePath
unpack Text
path)
        Handle -> FilePath -> IO ()
hPutStrLn Handle
stderr (FilePath
"Downloading: " FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> Text -> FilePath
unpack Text
path)
        Response ByteString
resp <- Request -> Manager -> IO (Response ByteString)
httpLbs Request
url Manager
manager
        ByteString -> IO ByteString
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ByteString -> IO ByteString) -> ByteString -> IO ByteString
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
toStrict (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ Response ByteString -> ByteString
forall body. Response body -> body
responseBody Response ByteString
resp

resolve Maybe FilePath
Nothing ResolverRef
_ = FilePath -> IO (Maybe FilePath, Resolver)
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail FilePath
"Remote snapshots can't use relative paths."


cache :: Text -> IO FilePath
cache :: Text -> IO FilePath
cache Text
file = do
    FilePath
dir <- XdgDirectory -> FilePath -> IO FilePath
getXdgDirectory XdgDirectory
XdgCache FilePath
"stackage"
    Bool -> FilePath -> IO ()
createDirectoryIfMissing Bool
True FilePath
dir
    FilePath -> IO FilePath
forall (f :: * -> *) a. Applicative f => a -> f a
pure (FilePath -> IO FilePath) -> FilePath -> IO FilePath
forall a b. (a -> b) -> a -> b
$ FilePath
dir FilePath -> FilePath -> FilePath
</> Text -> FilePath
unpack Text
file


stack2resolver :: Stack -> Resolver
stack2resolver :: Stack -> Resolver
stack2resolver Stack { ResolverRef
$sel:resolver:Stack :: Stack -> ResolverRef
resolver :: ResolverRef
resolver, Maybe Ghc
$sel:compiler:Stack :: Stack -> Maybe Ghc
compiler :: Maybe Ghc
compiler, [Package]
packages :: [Package]
$sel:packages:Stack :: Stack -> [Package]
packages, [Dep]
$sel:extraDeps:Stack :: Stack -> [Dep]
extraDeps :: [Dep]
extraDeps, Flags
$sel:flags:Stack :: Stack -> Flags
flags :: Flags
flags } =
    Maybe ResolverRef -> Maybe Ghc -> [Dep] -> Flags -> Resolver
Resolver (ResolverRef -> Maybe ResolverRef
forall a. a -> Maybe a
Just ResolverRef
resolver) Maybe Ghc
compiler ([Dep]
sourcedeps [Dep] -> [Dep] -> [Dep]
forall a. Semigroup a => a -> a -> a
<> [Dep]
extraDeps) Flags
flags
  where
    sourcedeps :: [Dep]
sourcedeps = (Package -> Maybe Dep) -> [Package] -> [Dep]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe Package -> Maybe Dep
pick [Package]
packages
    pick :: Package -> Maybe Dep
pick (Local FilePath
_) = Maybe Dep
forall a. Maybe a
Nothing
    pick (Location Git
g) = Dep -> Maybe Dep
forall a. a -> Maybe a
Just (Dep -> Maybe Dep) -> (Git -> Dep) -> Git -> Maybe Dep
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Git -> Dep
SourceDep (Git -> Maybe Dep) -> Git -> Maybe Dep
forall a b. (a -> b) -> a -> b
$ Git
g


new2old :: NewResolver -> Resolver
new2old :: NewResolver -> Resolver
new2old NewResolver { Ghc
$sel:compiler:NewResolver :: NewResolver -> Ghc
compiler :: Ghc
compiler, [NewDep]
$sel:packages:NewResolver :: NewResolver -> [NewDep]
packages :: [NewDep]
packages, Flags
$sel:flags:NewResolver :: NewResolver -> Flags
flags :: Flags
flags } = Maybe ResolverRef -> Maybe Ghc -> [Dep] -> Flags -> Resolver
Resolver
    Maybe ResolverRef
forall a. Maybe a
Nothing
    (Ghc -> Maybe Ghc
forall a. a -> Maybe a
Just Ghc
compiler)
    (NewDep -> Dep
new2old' (NewDep -> Dep) -> [NewDep] -> [Dep]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [NewDep]
packages)
    Flags
flags
    where new2old' :: NewDep -> Dep
new2old' (NewDep PkgId
pkg) = PkgId -> Dep
Hackage PkgId
pkg


-- | Merging two resolvers is straight-forward, except for
-- handling Git deps. These need to be merged carefully, because
-- stack.yaml may add subdirs to the repo of a resolver.
-- Also see: https://github.com/hasufell/stack2cabal/issues/30
mergeResolvers :: Resolver -> Resolver -> Resolver
mergeResolvers :: Resolver -> Resolver -> Resolver
mergeResolvers (Resolver Maybe ResolverRef
r Maybe Ghc
c [Dep]
p Flags
f) (Resolver Maybe ResolverRef
r' Maybe Ghc
c' [Dep]
p' Flags
f') =
    Maybe ResolverRef -> Maybe Ghc -> [Dep] -> Flags -> Resolver
Resolver (Maybe ResolverRef
r Maybe ResolverRef -> Maybe ResolverRef -> Maybe ResolverRef
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe ResolverRef
r') (Maybe Ghc
c Maybe Ghc -> Maybe Ghc -> Maybe Ghc
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe Ghc
c') ([Dep] -> [Dep] -> [Dep]
mergeDeps [Dep]
p [Dep]
p') (Flags
f Flags -> Flags -> Flags
forall a. Semigroup a => a -> a -> a
<> Flags
f')
  where
    mergeDeps :: [Dep] -> [Dep] -> [Dep]
    mergeDeps :: [Dep] -> [Dep] -> [Dep]
mergeDeps [Dep]
lhs [Dep]
rhs =
        let nonGits :: [Dep]
nonGits = (Dep -> Bool) -> [Dep] -> [Dep]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (Dep -> Bool) -> Dep -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Dep -> Bool
isGitDep) [Dep]
lhs [Dep] -> [Dep] -> [Dep]
forall a. Semigroup a => a -> a -> a
<> (Dep -> Bool) -> [Dep] -> [Dep]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (Dep -> Bool) -> Dep -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Dep -> Bool
isGitDep) [Dep]
rhs
            gitsLhs :: [Git]
gitsLhs = (\(SourceDep Git
dep) -> Git
dep) (Dep -> Git) -> [Dep] -> [Git]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Dep -> Bool) -> [Dep] -> [Dep]
forall a. (a -> Bool) -> [a] -> [a]
filter Dep -> Bool
isGitDep [Dep]
lhs
            gitsRhs :: [Git]
gitsRhs = (\(SourceDep Git
dep) -> Git
dep) (Dep -> Git) -> [Dep] -> [Git]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Dep -> Bool) -> [Dep] -> [Dep]
forall a. (a -> Bool) -> [a] -> [a]
filter Dep -> Bool
isGitDep [Dep]
rhs
            gitMerged :: [Git]
gitMerged = ([Git] -> Git -> [Git]) -> [Git] -> [Git] -> [Git]
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (\[Git]
m Git
key -> Git -> [Git] -> [Git]
update Git
key [Git]
m) [Git]
gitsRhs [Git]
gitsLhs
        in (Git -> Dep
SourceDep (Git -> Dep) -> [Git] -> [Dep]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Git]
gitMerged) [Dep] -> [Dep] -> [Dep]
forall a. Semigroup a => a -> a -> a
<> [Dep]
nonGits

    -- this is somewhat inefficient due to lists, but they're all fairly small
    update :: Git -> [Git] -> [Git]
    update :: Git -> [Git] -> [Git]
update Git
git [Git]
xs =
        -- find same repos
        case (Git -> Bool) -> [Git] -> Maybe Git
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (\Git
g -> Git
git { $sel:subdirs:Git :: [Text]
subdirs = [], $sel:commit:Git :: Text
commit = Text
"" }
                     Git -> Git -> Bool
forall a. Eq a => a -> a -> Bool
== Git
g { $sel:subdirs:Git :: [Text]
subdirs = [], $sel:commit:Git :: Text
commit = Text
"" })
                 [Git]
xs of
            Just Git
g
             -- on same commit, just append subdirs
             | Git -> Text
commit Git
g Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Git -> Text
commit Git
git
             -> Git
git { $sel:subdirs:Git :: [Text]
subdirs = [Text] -> [Text]
forall a. Eq a => [a] -> [a]
nub (Git -> [Text]
subdirs Git
git [Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
<> Git -> [Text]
subdirs Git
g) }
                 Git -> [Git] -> [Git]
forall a. a -> [a] -> [a]
: Git -> [Git] -> [Git]
forall a. Eq a => a -> [a] -> [a]
delete Git
g [Git]
xs
             -- on different commit need to delete subdirs from lower resolver
             | Bool
otherwise
             -> Git
git
                 -- > [0, 0, 0] \\ [0, 0]
                 -- [0]
                 Git -> [Git] -> [Git]
forall a. a -> [a] -> [a]
: Git
g { $sel:subdirs:Git :: [Text]
subdirs = [Text] -> [Text]
forall a. Eq a => [a] -> [a]
nub (Git -> [Text]
subdirs Git
g) [Text] -> [Text] -> [Text]
forall a. Eq a => [a] -> [a] -> [a]
\\ [Text] -> [Text]
forall a. Eq a => [a] -> [a]
nub (Git -> [Text]
subdirs Git
git) }
                 Git -> [Git] -> [Git]
forall a. a -> [a] -> [a]
: Git -> [Git] -> [Git]
forall a. Eq a => a -> [a] -> [a]
delete Git
g [Git]
xs
            Maybe Git
Nothing -> Git
git Git -> [Git] -> [Git]
forall a. a -> [a] -> [a]
: [Git]
xs

    isGitDep :: Dep -> Bool
    isGitDep :: Dep -> Bool
isGitDep (SourceDep Git
_) = Bool
True
    isGitDep Dep
_ = Bool
False

    delete :: Eq a => a -> [a] -> [a]
    delete :: a -> [a] -> [a]
delete a
deleted [a]
xs = [ a
x | a
x <- [a]
xs, a
x a -> a -> Bool
forall a. Eq a => a -> a -> Bool
/= a
deleted ]

--------------------------------------------------------------------------------
-- YAML

-- https://github.com/haskell-hvr/HsYAML/pull/5
decode1Strict :: FromYAML a => BS.ByteString -> Either String a
decode1Strict :: ByteString -> Either FilePath a
decode1Strict ByteString
text = do
    [a]
as <- case ByteString -> Either (Pos, FilePath) [a]
forall v. FromYAML v => ByteString -> Either (Pos, FilePath) [v]
decodeStrict ByteString
text of
        Left (Pos, FilePath)
e -> FilePath -> Either FilePath [a]
forall a b. a -> Either a b
Left (FilePath -> Either FilePath [a])
-> FilePath -> Either FilePath [a]
forall a b. (a -> b) -> a -> b
$ (Pos, FilePath) -> FilePath
forall a b. (a, b) -> b
snd (Pos, FilePath)
e
        Right [a]
a -> [a] -> Either FilePath [a]
forall a b. b -> Either a b
Right [a]
a
    Either FilePath a
-> (a -> Either FilePath a) -> Maybe a -> Either FilePath a
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (FilePath -> Either FilePath a
forall a b. a -> Either a b
Left FilePath
"expected unique") a -> Either FilePath a
forall a b. b -> Either a b
Right (Maybe a -> Either FilePath a) -> Maybe a -> Either FilePath a
forall a b. (a -> b) -> a -> b
$ [a] -> Maybe a
forall a. [a] -> Maybe a
listToMaybe [a]
as