{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE OverloadedStrings          #-}

module Package.C.PackageSet ( PackageSet (..)
                            , PackId
                            , pkgsM
                            , displayPackageSet
                            , displayPackage
                            , defaultPackageSetHash
                            ) where

import           CPkgPrelude
import           Data.Containers.ListUtils
import           Data.List                        (find, intersperse)
import qualified Data.Map                         as M
import qualified Data.Text                        as T
import           Data.Text.Prettyprint.Doc.Custom
import           Dhall                            hiding (maybe)
import qualified Package.C.Dhall.Type             as Dhall
import           Package.C.Error
import           Package.C.Type
import           Package.C.Type.Tree
import           Prettyprinter
import           Prettyprinter.Render.Text

defaultPackageSetHash :: T.Text
defaultPackageSetHash :: PackId
defaultPackageSetHash = PackId
"sha256:172035e1adc2b2f0e4035e943125f6c7afb53e2e0055313709d0c4208eb83850"

defaultPackageSetDhall :: Maybe String -> IO PackageSetDhall
defaultPackageSetDhall :: Maybe String -> IO PackageSetDhall
defaultPackageSetDhall (Just String
pkSet) = Decoder PackageSetDhall -> PackId -> IO PackageSetDhall
forall a. Decoder a -> PackId -> IO a
input Decoder PackageSetDhall
forall a. FromDhall a => Decoder a
auto (String -> PackId
T.pack String
pkSet)
defaultPackageSetDhall Maybe String
Nothing      = Decoder PackageSetDhall -> PackId -> IO PackageSetDhall
forall a. Decoder a -> PackId -> IO a
input Decoder PackageSetDhall
forall a. FromDhall a => Decoder a
auto (PackId
"https://raw.githubusercontent.com/vmchale/cpkg/a82629bc65449b66c0ab337faaeb0d12096675f6/pkgs/pkg-set.dhall " PackId -> PackId -> PackId
forall a. Semigroup a => a -> a -> a
<> PackId
defaultPackageSetHash)


displayPackageSet :: Maybe String -> IO ()
displayPackageSet :: Maybe String -> IO ()
displayPackageSet = Doc Any -> IO ()
forall ann. Doc ann -> IO ()
putDoc (Doc Any -> IO ())
-> (PackageSetDhall -> Doc Any) -> PackageSetDhall -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PackageSetDhall -> Doc Any
forall a ann. Pretty a => a -> Doc ann
forall ann. PackageSetDhall -> Doc ann
pretty (PackageSetDhall -> IO ())
-> (Maybe String -> IO PackageSetDhall) -> Maybe String -> IO ()
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< Maybe String -> IO PackageSetDhall
defaultPackageSetDhall

displayPackage :: String -> IO ()
displayPackage :: String -> IO ()
displayPackage String
str = do
    Maybe CPkg
pk <- (CPkg -> Bool) -> [CPkg] -> Maybe CPkg
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (\CPkg
ps -> PackId -> String
T.unpack (CPkg -> PackId
Dhall.pkgName CPkg
ps) String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
str) ([CPkg] -> Maybe CPkg)
-> (PackageSetDhall -> [CPkg]) -> PackageSetDhall -> Maybe CPkg
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PackageSetDhall -> [CPkg]
listPackages (PackageSetDhall -> Maybe CPkg)
-> IO PackageSetDhall -> IO (Maybe CPkg)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe String -> IO PackageSetDhall
defaultPackageSetDhall Maybe String
forall a. Maybe a
Nothing
    case Maybe CPkg
pk of
        Just CPkg
p  -> Doc Any -> IO ()
forall ann. Doc ann -> IO ()
putDoc (CPkg -> Doc Any
forall a ann. Pretty a => a -> Doc ann
forall ann. CPkg -> Doc ann
pretty CPkg
p Doc Any -> Doc Any -> Doc Any
forall a. Semigroup a => a -> a -> a
<> Doc Any
forall ann. Doc ann
hardline)
        Maybe CPkg
Nothing -> IO ()
forall (m :: * -> *) a. MonadIO m => m a
unfoundPackage

newtype PackageSetDhall = PackageSetDhall { PackageSetDhall -> [CPkg]
listPackages :: [ Dhall.CPkg ] }
    deriving InputNormalizer -> Decoder PackageSetDhall
(InputNormalizer -> Decoder PackageSetDhall)
-> FromDhall PackageSetDhall
forall a. (InputNormalizer -> Decoder a) -> FromDhall a
$cautoWith :: InputNormalizer -> Decoder PackageSetDhall
autoWith :: InputNormalizer -> Decoder PackageSetDhall
FromDhall

instance Pretty PackageSetDhall where
    pretty :: forall ann. PackageSetDhall -> Doc ann
pretty (PackageSetDhall [CPkg]
set) = [Doc ann] -> Doc ann
forall a. [Doc a] -> Doc a
vdisplay (Doc ann -> [Doc ann] -> [Doc ann]
forall a. a -> [a] -> [a]
intersperse Doc ann
forall ann. Doc ann
hardline (CPkg -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. CPkg -> Doc ann
pretty (CPkg -> Doc ann) -> [CPkg] -> [Doc ann]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [CPkg]
set)) Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
forall ann. Doc ann
hardline

newtype PackageSet = PackageSet (M.Map T.Text CPkg)

type PackId = T.Text

packageSetDhallToPackageSet :: PackageSetDhall -> PackageSet
packageSetDhallToPackageSet :: PackageSetDhall -> PackageSet
packageSetDhallToPackageSet (PackageSetDhall [CPkg]
pkgs'') =
    let names :: [PackId]
names = CPkg -> PackId
Dhall.pkgName (CPkg -> PackId) -> [CPkg] -> [PackId]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [CPkg]
pkgs''
        pkgs' :: [CPkg]
pkgs' = CPkg -> CPkg
cPkgDhallToCPkg (CPkg -> CPkg) -> [CPkg] -> [CPkg]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [CPkg]
pkgs''

        in Map PackId CPkg -> PackageSet
PackageSet (Map PackId CPkg -> PackageSet) -> Map PackId CPkg -> PackageSet
forall a b. (a -> b) -> a -> b
$ [(PackId, CPkg)] -> Map PackId CPkg
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ([PackId] -> [CPkg] -> [(PackId, CPkg)]
forall a b. [a] -> [b] -> [(a, b)]
zip [PackId]
names [CPkg]
pkgs')

getDeps :: PackId -> Bool -> PackageSet -> Maybe (DepTree PackId)
getDeps :: PackId -> Bool -> PackageSet -> Maybe (DepTree PackId)
getDeps PackId
pkgName' Bool
usr set :: PackageSet
set@(PackageSet Map PackId CPkg
ps) = do
    CPkg
cpkg <- PackId -> Map PackId CPkg -> Maybe CPkg
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup PackId
pkgName' Map PackId CPkg
ps
    let depNames :: [PackId]
depNames = Dep -> PackId
name (Dep -> PackId) -> [Dep] -> [PackId]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CPkg -> [Dep]
pkgDeps CPkg
cpkg
        bldDepNames :: [PackId]
bldDepNames = Dep -> PackId
name (Dep -> PackId) -> [Dep] -> [PackId]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CPkg -> [Dep]
pkgBuildDeps CPkg
cpkg
        ds :: [PackId]
ds = [PackId] -> [PackId]
forall a. Ord a => [a] -> [a]
nubOrd [PackId]
depNames
        bds :: [PackId]
bds = [PackId] -> [PackId]
forall a. Ord a => [a] -> [a]
nubOrd [PackId]
bldDepNames
    [DepTree PackId]
nextDeps <- (PackId -> Maybe (DepTree PackId))
-> [PackId] -> Maybe [DepTree PackId]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse (\PackId
p -> PackId -> Bool -> PackageSet -> Maybe (DepTree PackId)
getDeps PackId
p Bool
False PackageSet
set) [PackId]
ds
    [DepTree PackId]
nextBldDeps <- (PackId -> Maybe (DepTree PackId))
-> [PackId] -> Maybe [DepTree PackId]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse (\PackId
p -> DepTree PackId -> DepTree PackId
forall p. DepTree p -> DepTree p
asBldDep (DepTree PackId -> DepTree PackId)
-> Maybe (DepTree PackId) -> Maybe (DepTree PackId)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> PackId -> Bool -> PackageSet -> Maybe (DepTree PackId)
getDeps PackId
p Bool
False PackageSet
set) [PackId]
bds
    DepTree PackId -> Maybe (DepTree PackId)
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (DepTree PackId -> Maybe (DepTree PackId))
-> DepTree PackId -> Maybe (DepTree PackId)
forall a b. (a -> b) -> a -> b
$ PackId -> Bool -> [DepTree PackId] -> DepTree PackId
forall p. p -> Bool -> [DepTree p] -> DepTree p
DepNode PackId
pkgName' Bool
usr ([DepTree PackId]
nextDeps [DepTree PackId] -> [DepTree PackId] -> [DepTree PackId]
forall a. [a] -> [a] -> [a]
++ [DepTree PackId]
nextBldDeps)

-- TODO: use dfsForest but check for cycles
pkgPlan :: PackId -> PackageSet -> Maybe (DepTree PackId)
pkgPlan :: PackId -> PackageSet -> Maybe (DepTree PackId)
pkgPlan PackId
pkId = PackId -> Bool -> PackageSet -> Maybe (DepTree PackId)
getDeps PackId
pkId Bool
True -- manually installed

pkgs :: PackId -> PackageSet -> Maybe (DepTree CPkg)
pkgs :: PackId -> PackageSet -> Maybe (DepTree CPkg)
pkgs PackId
pkId set :: PackageSet
set@(PackageSet Map PackId CPkg
pset) = do
    DepTree PackId
plan <- PackId -> PackageSet -> Maybe (DepTree PackId)
pkgPlan PackId
pkId PackageSet
set
    (PackId -> Maybe CPkg) -> DepTree PackId -> Maybe (DepTree CPkg)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> DepTree a -> f (DepTree b)
traverse (PackId -> Map PackId CPkg -> Maybe CPkg
forall k a. Ord k => k -> Map k a -> Maybe a
`M.lookup` Map PackId CPkg
pset) DepTree PackId
plan

pkgsM :: PackId -> Maybe String -> IO (DepTree CPkg)
pkgsM :: PackId -> Maybe String -> IO (DepTree CPkg)
pkgsM PackId
pkId Maybe String
pkSet = do
    Maybe (DepTree CPkg)
pks <- PackId -> PackageSet -> Maybe (DepTree CPkg)
pkgs PackId
pkId (PackageSet -> Maybe (DepTree CPkg))
-> (PackageSetDhall -> PackageSet)
-> PackageSetDhall
-> Maybe (DepTree CPkg)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PackageSetDhall -> PackageSet
packageSetDhallToPackageSet (PackageSetDhall -> Maybe (DepTree CPkg))
-> IO PackageSetDhall -> IO (Maybe (DepTree CPkg))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe String -> IO PackageSetDhall
defaultPackageSetDhall Maybe String
pkSet
    IO (DepTree CPkg)
-> (DepTree CPkg -> IO (DepTree CPkg))
-> Maybe (DepTree CPkg)
-> IO (DepTree CPkg)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe IO (DepTree CPkg)
forall (m :: * -> *) a. MonadIO m => m a
unfoundPackage DepTree CPkg -> IO (DepTree CPkg)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (DepTree CPkg)
pks