{-# LANGUAGE OverloadedStrings #-}

module Poseidon.CLI.List (runList, ListOptions(..), ListEntity(..), RepoLocationSpec(..)) where

import           Poseidon.EntityTypes   (HasNameAndVersion (..))
import           Poseidon.Package       (PackageReadOptions (..),
                                         defaultPackageReadOptions,
                                         getAllGroupInfo,
                                         getExtendedIndividualInfo,
                                         packagesToPackageInfos,
                                         readPoseidonPackageCollection)
import           Poseidon.ServerClient  (AddJannoColSpec (..),
                                         ApiReturnData (..),
                                         ArchiveEndpoint (..),
                                         ExtendedIndividualInfo (..),
                                         GroupInfo (..), PackageInfo (..),
                                         processApiResponse, qDefault)
import           Poseidon.Utils         (PoseidonIO, logInfo, logWarning)

import           Control.Monad          (forM_, when)
import           Control.Monad.IO.Class (liftIO)
import           Data.List              (intercalate, sortOn)
import           Data.Maybe             (catMaybes, fromMaybe)
import           Data.Version           (Version, showVersion)

import           Text.Layout.Table      (asciiRoundS, column, def, expandUntil,
                                         rowsG, tableString, titlesH)

-- | A datatype representing command line options for the list command
data ListOptions = ListOptions
    { ListOptions -> RepoLocationSpec
_listRepoLocation :: RepoLocationSpec -- ^ the list of base directories to search for packages
    , ListOptions -> ListEntity
_listListEntity   :: ListEntity -- ^ what to list
    , ListOptions -> Bool
_listRawOutput    :: Bool -- ^ whether to output raw TSV instead of a nicely formatted table
    , ListOptions -> Bool
_listOnlyLatest   :: Bool -- ^ whether to show only latest versions of packages
    }

data RepoLocationSpec = RepoLocal [FilePath] | RepoRemote ArchiveEndpoint

-- | A datatype to represent the options what to list
data ListEntity = ListPackages
    | ListGroups
    | ListIndividuals AddJannoColSpec

-- | The main function running the list command
runList :: ListOptions -> PoseidonIO ()
runList :: ListOptions -> PoseidonIO ()
runList (ListOptions RepoLocationSpec
repoLocation ListEntity
listEntity Bool
rawOutput Bool
onlyLatest) = do
    let pacReadOpts :: PackageReadOptions
pacReadOpts = PackageReadOptions
defaultPackageReadOptions {
          _readOptIgnoreChecksums :: Bool
_readOptIgnoreChecksums      = Bool
True
        , _readOptGenoCheck :: Bool
_readOptGenoCheck            = Bool
False
        , _readOptIgnoreGeno :: Bool
_readOptIgnoreGeno           = Bool
True
        , _readOptOnlyLatest :: Bool
_readOptOnlyLatest           = Bool
onlyLatest
    }
    -- build tables
    ([String]
tableH, [[String]]
tableB) <- case ListEntity
listEntity of
        ListEntity
ListPackages -> do
            [PackageInfo]
packageInfos <- case RepoLocationSpec
repoLocation of
                RepoRemote (ArchiveEndpoint String
remoteURL Maybe String
archive) -> do
                    String -> PoseidonIO ()
logInfo String
"Downloading package data from server"
                    ApiReturnData
apiReturn <- String -> Bool -> PoseidonIO ApiReturnData
processApiResponse (String
remoteURL String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"/packages" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Maybe String -> String
qDefault Maybe String
archive) Bool
False
                    case ApiReturnData
apiReturn of
                        ApiReturnPackageInfo [PackageInfo]
pacInfo -> [PackageInfo] -> ReaderT Env IO [PackageInfo]
forall a. a -> ReaderT Env IO a
forall (m :: * -> *) a. Monad m => a -> m a
return [PackageInfo]
pacInfo
                        ApiReturnData
_ -> String -> ReaderT Env IO [PackageInfo]
forall a. HasCallStack => String -> a
error String
"should not happen"
                RepoLocal [String]
baseDirs -> do
                    [PoseidonPackage]
pacCollection <- PackageReadOptions -> [String] -> PoseidonIO [PoseidonPackage]
readPoseidonPackageCollection PackageReadOptions
pacReadOpts [String]
baseDirs
                    [PoseidonPackage] -> ReaderT Env IO [PackageInfo]
forall (m :: * -> *).
MonadThrow m =>
[PoseidonPackage] -> m [PackageInfo]
packagesToPackageInfos [PoseidonPackage]
pacCollection
            let tableH :: [String]
tableH = [String
"Package", String
"Package Version", String
"Is Latest", String
"Poseidon Version", String
"Description", String
"Last modified", String
"Nr Individuals"]
                tableB :: [[String]]
tableB = ([String] -> String) -> [[String]] -> [[String]]
forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn [String] -> String
forall a. HasCallStack => [a] -> a
head ([[String]] -> [[String]]) -> [[String]] -> [[String]]
forall a b. (a -> b) -> a -> b
$ do
                    pInf :: PackageInfo
pInf@(PackageInfo PacNameAndVersion
_ Bool
isLatest Version
posV Maybe String
desc Maybe Day
lastMod Int
nrInds) <- [PackageInfo]
packageInfos
                    -- for the locally read packages this doesn't do anything,
                    -- because the dataset is already reduced to the latest packages
                    -- in the reading process
                    Bool
True <- Bool -> [Bool]
forall a. a -> [a]
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> Bool
not Bool
onlyLatest Bool -> Bool -> Bool
|| Bool
isLatest)
                    [String] -> [[String]]
forall a. a -> [a]
forall (m :: * -> *) a. Monad m => a -> m a
return [PackageInfo -> String
forall a. HasNameAndVersion a => a -> String
getPacName PackageInfo
pInf, Maybe Version -> String
showMaybeVersion (PackageInfo -> Maybe Version
forall a. HasNameAndVersion a => a -> Maybe Version
getPacVersion PackageInfo
pInf), Bool -> String
forall a. Show a => a -> String
show Bool
isLatest,
                            Version -> String
showVersion Version
posV, Maybe String -> String
showMaybe Maybe String
desc, Maybe String -> String
showMaybe (Day -> String
forall a. Show a => a -> String
show (Day -> String) -> Maybe Day -> Maybe String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Day
lastMod), Int -> String
forall a. Show a => a -> String
show Int
nrInds]
            ([String], [[String]]) -> ReaderT Env IO ([String], [[String]])
forall a. a -> ReaderT Env IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ([String]
tableH, [[String]]
tableB)
        ListEntity
ListGroups -> do
            [GroupInfo]
groupInfos <- case RepoLocationSpec
repoLocation of
                RepoRemote (ArchiveEndpoint String
remoteURL Maybe String
archive) -> do
                    String -> PoseidonIO ()
logInfo String
"Downloading group data from server"
                    ApiReturnData
apiReturn <- String -> Bool -> PoseidonIO ApiReturnData
processApiResponse (String
remoteURL String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"/groups" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Maybe String -> String
qDefault Maybe String
archive) Bool
False
                    case ApiReturnData
apiReturn of
                        ApiReturnGroupInfo [GroupInfo]
groupInfo -> [GroupInfo] -> ReaderT Env IO [GroupInfo]
forall a. a -> ReaderT Env IO a
forall (m :: * -> *) a. Monad m => a -> m a
return [GroupInfo]
groupInfo
                        ApiReturnData
_ -> String -> ReaderT Env IO [GroupInfo]
forall a. HasCallStack => String -> a
error String
"should not happen"
                RepoLocal [String]
baseDirs -> do
                    [PoseidonPackage]
pacCollection <- PackageReadOptions -> [String] -> PoseidonIO [PoseidonPackage]
readPoseidonPackageCollection PackageReadOptions
pacReadOpts [String]
baseDirs
                    [PoseidonPackage] -> ReaderT Env IO [GroupInfo]
forall (m :: * -> *).
MonadThrow m =>
[PoseidonPackage] -> m [GroupInfo]
getAllGroupInfo [PoseidonPackage]
pacCollection
            let tableH :: [String]
tableH = [String
"Group", String
"Package", String
"Package Version", String
"Is Latest", String
"Nr Individuals"]
                tableB :: [[String]]
tableB = do
                    gi :: GroupInfo
gi@(GroupInfo String
groupName PacNameAndVersion
_ Bool
isLatest Int
nrInds) <- [GroupInfo]
groupInfos
                    Bool
True <- Bool -> [Bool]
forall a. a -> [a]
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> Bool
not Bool
onlyLatest Bool -> Bool -> Bool
|| Bool
isLatest)
                    [String] -> [[String]]
forall a. a -> [a]
forall (m :: * -> *) a. Monad m => a -> m a
return [String
groupName, GroupInfo -> String
forall a. HasNameAndVersion a => a -> String
getPacName GroupInfo
gi, Maybe Version -> String
showMaybeVersion (GroupInfo -> Maybe Version
forall a. HasNameAndVersion a => a -> Maybe Version
getPacVersion GroupInfo
gi), Bool -> String
forall a. Show a => a -> String
show Bool
isLatest, Int -> String
forall a. Show a => a -> String
show Int
nrInds]
            ([String], [[String]]) -> ReaderT Env IO ([String], [[String]])
forall a. a -> ReaderT Env IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ([String]
tableH, [[String]]
tableB)
        ListIndividuals AddJannoColSpec
addJannoColSpec -> do
            [ExtendedIndividualInfo]
extIndInfos <- case RepoLocationSpec
repoLocation of
                RepoRemote (ArchiveEndpoint String
remoteURL Maybe String
archive) -> do
                    String -> PoseidonIO ()
logInfo String
"Downloading individual data from server"
                    let addJannoColFlag :: String
addJannoColFlag = case AddJannoColSpec
addJannoColSpec of
                            AddJannoColSpec
AddJannoColAll -> String
"&additionalJannoColumns=ALL"
                            AddJannoColList [] -> String
""
                            AddJannoColList [String]
moreJannoColumns -> String
"&additionalJannoColumns=" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
"," [String]
moreJannoColumns
                    ApiReturnData
apiReturn <- String -> Bool -> PoseidonIO ApiReturnData
processApiResponse (String
remoteURL String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"/individuals" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Maybe String -> String
qDefault Maybe String
archive String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
addJannoColFlag) Bool
False
                    case ApiReturnData
apiReturn of
                        ApiReturnExtIndividualInfo [ExtendedIndividualInfo]
indInfo -> [ExtendedIndividualInfo] -> ReaderT Env IO [ExtendedIndividualInfo]
forall a. a -> ReaderT Env IO a
forall (m :: * -> *) a. Monad m => a -> m a
return [ExtendedIndividualInfo]
indInfo
                        ApiReturnData
_ -> String -> ReaderT Env IO [ExtendedIndividualInfo]
forall a. HasCallStack => String -> a
error String
"should not happen"
                RepoLocal [String]
baseDirs -> do
                    [PoseidonPackage]
pacCollection <- PackageReadOptions -> [String] -> PoseidonIO [PoseidonPackage]
readPoseidonPackageCollection PackageReadOptions
pacReadOpts [String]
baseDirs
                    [PoseidonPackage]
-> AddJannoColSpec -> ReaderT Env IO [ExtendedIndividualInfo]
forall (m :: * -> *).
MonadThrow m =>
[PoseidonPackage] -> AddJannoColSpec -> m [ExtendedIndividualInfo]
getExtendedIndividualInfo [PoseidonPackage]
pacCollection AddJannoColSpec
addJannoColSpec

            let addJannoCols :: [String]
addJannoCols = case [ExtendedIndividualInfo]
extIndInfos of -- get all add-column names from first extIndInfo
                    []    -> []
                    (ExtendedIndividualInfo
e:[ExtendedIndividualInfo]
_) -> ((String, Maybe String) -> String)
-> [(String, Maybe String)] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String, Maybe String) -> String
forall a b. (a, b) -> a
fst ([(String, Maybe String)] -> [String])
-> (ExtendedIndividualInfo -> [(String, Maybe String)])
-> ExtendedIndividualInfo
-> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ExtendedIndividualInfo -> [(String, Maybe String)]
extIndInfoAddCols (ExtendedIndividualInfo -> [String])
-> ExtendedIndividualInfo -> [String]
forall a b. (a -> b) -> a -> b
$ ExtendedIndividualInfo
e

            -- warning in case the additional Columns do not exist in the entire janno dataset,
            -- we only output this warning if the columns were requested explicitly. Not if
            -- all columns were requested. We consider such an "all" request to mean "all columns that are present".
            case AddJannoColSpec
addJannoColSpec of
                AddJannoColList (String
_:[String]
_) -> do
                    [(Int, String)]
-> ((Int, String) -> PoseidonIO ()) -> PoseidonIO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ ([Int] -> [String] -> [(Int, String)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0..] [String]
addJannoCols) (((Int, String) -> PoseidonIO ()) -> PoseidonIO ())
-> ((Int, String) -> PoseidonIO ()) -> PoseidonIO ()
forall a b. (a -> b) -> a -> b
$ \(Int
i, String
columnKey) -> do
                        -- check entries in all individuals for that key
                        let nonEmptyEntries :: [String]
nonEmptyEntries = [Maybe String] -> [String]
forall a. [Maybe a] -> [a]
catMaybes [(String, Maybe String) -> Maybe String
forall a b. (a, b) -> b
snd ([(String, Maybe String)]
entries [(String, Maybe String)] -> Int -> (String, Maybe String)
forall a. HasCallStack => [a] -> Int -> a
!! Int
i) | ExtendedIndividualInfo String
_ [String]
_ PacNameAndVersion
_ Bool
_ [(String, Maybe String)]
entries <- [ExtendedIndividualInfo]
extIndInfos]
                        Bool -> PoseidonIO () -> PoseidonIO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ([String] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
nonEmptyEntries) (PoseidonIO () -> PoseidonIO ())
-> (String -> PoseidonIO ()) -> String -> PoseidonIO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> PoseidonIO ()
logWarning (String -> PoseidonIO ()) -> String -> PoseidonIO ()
forall a b. (a -> b) -> a -> b
$ String
"Column Name " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
columnKey String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" not present in any individual"
                AddJannoColSpec
_ -> () -> PoseidonIO ()
forall a. a -> ReaderT Env IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

            let tableH :: [String]
tableH = [String
"Individual", String
"Group", String
"Package", String
"PackageVersion", String
"Is Latest"] [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String]
addJannoCols
                tableB :: [[String]]
tableB = do
                    i :: ExtendedIndividualInfo
i@(ExtendedIndividualInfo String
name [String]
groups PacNameAndVersion
_ Bool
isLatest [(String, Maybe String)]
addColumnEntries) <- [ExtendedIndividualInfo]
extIndInfos
                    Bool
True <- Bool -> [Bool]
forall a. a -> [a]
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> Bool
not Bool
onlyLatest Bool -> Bool -> Bool
|| Bool
isLatest)
                    [String] -> [[String]]
forall a. a -> [a]
forall (m :: * -> *) a. Monad m => a -> m a
return ([String] -> [[String]]) -> [String] -> [[String]]
forall a b. (a -> b) -> a -> b
$ [String
name, String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
", " [String]
groups, ExtendedIndividualInfo -> String
forall a. HasNameAndVersion a => a -> String
getPacName ExtendedIndividualInfo
i,
                              Maybe Version -> String
showMaybeVersion (ExtendedIndividualInfo -> Maybe Version
forall a. HasNameAndVersion a => a -> Maybe Version
getPacVersion ExtendedIndividualInfo
i), Bool -> String
forall a. Show a => a -> String
show  Bool
isLatest] [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++
                              ((String, Maybe String) -> String)
-> [(String, Maybe String)] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String -> Maybe String -> String
forall a. a -> Maybe a -> a
fromMaybe String
"n/a" (Maybe String -> String)
-> ((String, Maybe String) -> Maybe String)
-> (String, Maybe String)
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String, Maybe String) -> Maybe String
forall a b. (a, b) -> b
snd) [(String, Maybe String)]
addColumnEntries
            ([String], [[String]]) -> ReaderT Env IO ([String], [[String]])
forall a. a -> ReaderT Env IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ([String]
tableH, [[String]]
tableB)
    if Bool
rawOutput then
        IO () -> PoseidonIO ()
forall a. IO a -> ReaderT Env IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> PoseidonIO ()) -> IO () -> PoseidonIO ()
forall a b. (a -> b) -> a -> b
$ String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
"\n" [String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
"\t" [String]
row | [String]
row <- [String]
tableH[String] -> [[String]] -> [[String]]
forall a. a -> [a] -> [a]
:[[String]]
tableB]
    else do
        let colSpecs :: [ColSpec]
colSpecs = Int -> ColSpec -> [ColSpec]
forall a. Int -> a -> [a]
replicate ([String] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [String]
tableH) (LenSpec -> Position H -> AlignSpec -> CutMark -> ColSpec
column (Int -> LenSpec
expandUntil Int
60) Position H
forall a. Default a => a
def AlignSpec
forall a. Default a => a
def CutMark
forall a. Default a => a
def)
        IO () -> PoseidonIO ()
forall a. IO a -> ReaderT Env IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> PoseidonIO ()) -> IO () -> PoseidonIO ()
forall a b. (a -> b) -> a -> b
$ String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ [ColSpec]
-> TableStyle -> HeaderSpec -> [RowGroup String] -> String
forall a.
Cell a =>
[ColSpec] -> TableStyle -> HeaderSpec -> [RowGroup a] -> String
tableString [ColSpec]
colSpecs TableStyle
asciiRoundS ([String] -> HeaderSpec
titlesH [String]
tableH) [[[String]] -> RowGroup String
forall a. [Row a] -> RowGroup a
rowsG [[String]]
tableB]
  where
    showMaybe :: Maybe String -> String
    showMaybe :: Maybe String -> String
showMaybe = String -> Maybe String -> String
forall a. a -> Maybe a -> a
fromMaybe String
"n/a"
    showMaybeVersion :: Maybe Version -> String
    showMaybeVersion :: Maybe Version -> String
showMaybeVersion = String -> (Version -> String) -> Maybe Version -> String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe String
"n/a" Version -> String
showVersion