{-# LANGUAGE DeriveGeneric     #-}
{-# LANGUAGE OverloadedStrings #-}

module Poseidon.EntityTypes (
    IndividualInfo (..),
    IndividualInfoCollection,
    renderNameWithVersion,
    HasNameAndVersion (..),
    PoseidonEntity(..),
    SignedEntity(..),
    hasVersion, EntitiesList, SignedEntitiesList,
    PacNameAndVersion(..), makePacNameAndVersion, isLatestInCollection,
    EntitySpec,
    resolveUniqueEntityIndices,
    indInfoConformsToEntitySpecs, underlyingEntity, entitySpecParser,
    readEntitiesFromFile, readEntitiesFromString,
    determineNonExistentEntities, determineRelevantPackages,
    entitiesListP, EntityInput(..), readEntityInputs,
    checkIfAllEntitiesExist,
    resolveEntityIndices, reportDuplicateIndividuals) where

import           Poseidon.Utils         (PoseidonException (..), PoseidonIO,
                                         logError, showParsecErr)
import           Poseidon.Version       (parseVersion)

import           Control.Applicative    ((<|>))
import           Control.Exception      (throwIO)
import           Control.Monad          (forM, forM_, unless, when)
import           Control.Monad.Catch    (MonadThrow, throwM)
import           Control.Monad.IO.Class (MonadIO, liftIO)
import           Data.Aeson             (FromJSON (..), ToJSON (..), Value (..),
                                         withText)
import           Data.Aeson.Types       (Parser)
import           Data.Char              (isSpace)
import           Data.List              (groupBy, intercalate, nub, sortOn,
                                         (\\))
import           Data.Maybe             (isJust, isNothing, mapMaybe)
import           Data.Text              (Text, pack, unpack)
import           Data.Version           (Version, showVersion)
import           GHC.Generics           (Generic)
import qualified Text.Parsec            as P
import qualified Text.Parsec.String     as P

-- | A class to represent a package-identifying property
class Eq a => HasNameAndVersion a where
    getPacName     :: a -> String        -- ^ a name property
    getPacVersion  :: a -> Maybe Version -- ^ a version property

-- | a convenience function
hasVersion :: (HasNameAndVersion a) => a -> Bool
hasVersion :: forall a. HasNameAndVersion a => a -> Bool
hasVersion = Maybe Version -> Bool
forall a. Maybe a -> Bool
isJust (Maybe Version -> Bool) -> (a -> Maybe Version) -> a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Maybe Version
forall a. HasNameAndVersion a => a -> Maybe Version
getPacVersion

-- | universal rendering of package names and version
renderNameWithVersion :: (HasNameAndVersion a) => a -> String
renderNameWithVersion :: forall a. HasNameAndVersion a => a -> String
renderNameWithVersion a
a = case a -> Maybe Version
forall a. HasNameAndVersion a => a -> Maybe Version
getPacVersion a
a of
    Maybe Version
Nothing -> a -> String
forall a. HasNameAndVersion a => a -> String
getPacName a
a
    Just Version
v  -> a -> String
forall a. HasNameAndVersion a => a -> String
getPacName a
a String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"-" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Version -> String
showVersion Version
v

-- | a function to check whether a given package is the latest within a collection
isLatestInCollection :: (MonadThrow m, HasNameAndVersion a) => [a] -> a -> m Bool
isLatestInCollection :: forall (m :: * -> *) a.
(MonadThrow m, HasNameAndVersion a) =>
[a] -> a -> m Bool
isLatestInCollection [a]
pacCollection a
onePac = do
    let nameOfOne :: String
nameOfOne = a -> String
forall a. HasNameAndVersion a => a -> String
getPacName a
onePac
        allWithThisName :: [PacNameAndVersion]
allWithThisName = [PacNameAndVersion] -> [PacNameAndVersion]
forall a. Eq a => [a] -> [a]
nub ([PacNameAndVersion] -> [PacNameAndVersion])
-> [PacNameAndVersion] -> [PacNameAndVersion]
forall a b. (a -> b) -> a -> b
$ (PacNameAndVersion -> Bool)
-> [PacNameAndVersion] -> [PacNameAndVersion]
forall a. (a -> Bool) -> [a] -> [a]
filter ((String -> String -> Bool
forall a. Eq a => a -> a -> Bool
==String
nameOfOne) (String -> Bool)
-> (PacNameAndVersion -> String) -> PacNameAndVersion -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PacNameAndVersion -> String
forall a. HasNameAndVersion a => a -> String
getPacName) ([PacNameAndVersion] -> [PacNameAndVersion])
-> [PacNameAndVersion] -> [PacNameAndVersion]
forall a b. (a -> b) -> a -> b
$ (a -> PacNameAndVersion) -> [a] -> [PacNameAndVersion]
forall a b. (a -> b) -> [a] -> [b]
map a -> PacNameAndVersion
forall a. HasNameAndVersion a => a -> PacNameAndVersion
makePacNameAndVersion [a]
pacCollection
        -- the latest package can not be determined, if there is more than one with this name
        -- and any of them has no specified version
        missingVersion :: Bool
missingVersion = (PacNameAndVersion -> Bool) -> [PacNameAndVersion] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Maybe Version -> Bool
forall a. Maybe a -> Bool
isNothing (Maybe Version -> Bool)
-> (PacNameAndVersion -> Maybe Version)
-> PacNameAndVersion
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PacNameAndVersion -> Maybe Version
forall a. HasNameAndVersion a => a -> Maybe Version
getPacVersion) [PacNameAndVersion]
allWithThisName Bool -> Bool -> Bool
&& [PacNameAndVersion] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [PacNameAndVersion]
allWithThisName Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
1
    Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
missingVersion (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
        PoseidonException -> m ()
forall e a. Exception e => e -> m a
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (PoseidonException -> m ()) -> PoseidonException -> m ()
forall a b. (a -> b) -> a -> b
$ String -> PoseidonException
PoseidonCollectionException (String -> PoseidonException) -> String -> PoseidonException
forall a b. (a -> b) -> a -> b
$
            String
"Can not resolve latest package, because of missing version numbers: " String -> String -> String
forall a. [a] -> [a] -> [a]
++
            String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
"," ((PacNameAndVersion -> String) -> [PacNameAndVersion] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map PacNameAndVersion -> String
forall a. HasNameAndVersion a => a -> String
renderNameWithVersion [PacNameAndVersion]
allWithThisName)
    let latest :: PacNameAndVersion
latest = [PacNameAndVersion] -> PacNameAndVersion
forall a. Ord a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum [PacNameAndVersion]
allWithThisName
    Bool -> m Bool
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> m Bool) -> Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ a -> PacNameAndVersion
forall a. HasNameAndVersion a => a -> PacNameAndVersion
makePacNameAndVersion a
onePac PacNameAndVersion -> PacNameAndVersion -> Bool
forall a. Eq a => a -> a -> Bool
== PacNameAndVersion
latest

-- | The minimal instance of HasNameAndVersion
data PacNameAndVersion = PacNameAndVersion {
      PacNameAndVersion -> String
panavName    :: String
    , PacNameAndVersion -> Maybe Version
panavVersion :: Maybe Version
    }
    deriving (Eq PacNameAndVersion
Eq PacNameAndVersion
-> (PacNameAndVersion -> PacNameAndVersion -> Ordering)
-> (PacNameAndVersion -> PacNameAndVersion -> Bool)
-> (PacNameAndVersion -> PacNameAndVersion -> Bool)
-> (PacNameAndVersion -> PacNameAndVersion -> Bool)
-> (PacNameAndVersion -> PacNameAndVersion -> Bool)
-> (PacNameAndVersion -> PacNameAndVersion -> PacNameAndVersion)
-> (PacNameAndVersion -> PacNameAndVersion -> PacNameAndVersion)
-> Ord PacNameAndVersion
PacNameAndVersion -> PacNameAndVersion -> Bool
PacNameAndVersion -> PacNameAndVersion -> Ordering
PacNameAndVersion -> PacNameAndVersion -> PacNameAndVersion
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: PacNameAndVersion -> PacNameAndVersion -> Ordering
compare :: PacNameAndVersion -> PacNameAndVersion -> Ordering
$c< :: PacNameAndVersion -> PacNameAndVersion -> Bool
< :: PacNameAndVersion -> PacNameAndVersion -> Bool
$c<= :: PacNameAndVersion -> PacNameAndVersion -> Bool
<= :: PacNameAndVersion -> PacNameAndVersion -> Bool
$c> :: PacNameAndVersion -> PacNameAndVersion -> Bool
> :: PacNameAndVersion -> PacNameAndVersion -> Bool
$c>= :: PacNameAndVersion -> PacNameAndVersion -> Bool
>= :: PacNameAndVersion -> PacNameAndVersion -> Bool
$cmax :: PacNameAndVersion -> PacNameAndVersion -> PacNameAndVersion
max :: PacNameAndVersion -> PacNameAndVersion -> PacNameAndVersion
$cmin :: PacNameAndVersion -> PacNameAndVersion -> PacNameAndVersion
min :: PacNameAndVersion -> PacNameAndVersion -> PacNameAndVersion
Ord, PacNameAndVersion -> PacNameAndVersion -> Bool
(PacNameAndVersion -> PacNameAndVersion -> Bool)
-> (PacNameAndVersion -> PacNameAndVersion -> Bool)
-> Eq PacNameAndVersion
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PacNameAndVersion -> PacNameAndVersion -> Bool
== :: PacNameAndVersion -> PacNameAndVersion -> Bool
$c/= :: PacNameAndVersion -> PacNameAndVersion -> Bool
/= :: PacNameAndVersion -> PacNameAndVersion -> Bool
Eq)

instance HasNameAndVersion PacNameAndVersion where
    getPacName :: PacNameAndVersion -> String
getPacName     = PacNameAndVersion -> String
panavName
    getPacVersion :: PacNameAndVersion -> Maybe Version
getPacVersion  = PacNameAndVersion -> Maybe Version
panavVersion

instance Show PacNameAndVersion where
    show :: PacNameAndVersion -> String
show PacNameAndVersion
a = String
"*" String -> String -> String
forall a. [a] -> [a] -> [a]
++ PacNameAndVersion -> String
forall a. HasNameAndVersion a => a -> String
renderNameWithVersion PacNameAndVersion
a String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"*"

-- | a function to normalise any instance of HasNameAndVersion to the minimal concrete type PacNameAndVersion
makePacNameAndVersion :: (HasNameAndVersion a) => a -> PacNameAndVersion
makePacNameAndVersion :: forall a. HasNameAndVersion a => a -> PacNameAndVersion
makePacNameAndVersion a
a = String -> Maybe Version -> PacNameAndVersion
PacNameAndVersion (a -> String
forall a. HasNameAndVersion a => a -> String
getPacName a
a) (a -> Maybe Version
forall a. HasNameAndVersion a => a -> Maybe Version
getPacVersion a
a)

-- | A datatype to represent a requested package, group or individual
data PoseidonEntity =
      Pac PacNameAndVersion -- ^ all individuals in a package. A version can be specified, if not implicitly request the latest
    | Group String          -- ^ all individuals with a given group, in all of the latest packages
    | Ind String            -- ^ all individuals with the given name, in all of the latest packages
    | SpecificInd String String PacNameAndVersion -- ^ the individual specified by its name, group and package. If not versioned, then take the latest version.
    deriving (PoseidonEntity -> PoseidonEntity -> Bool
(PoseidonEntity -> PoseidonEntity -> Bool)
-> (PoseidonEntity -> PoseidonEntity -> Bool) -> Eq PoseidonEntity
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PoseidonEntity -> PoseidonEntity -> Bool
== :: PoseidonEntity -> PoseidonEntity -> Bool
$c/= :: PoseidonEntity -> PoseidonEntity -> Bool
/= :: PoseidonEntity -> PoseidonEntity -> Bool
Eq, Eq PoseidonEntity
Eq PoseidonEntity
-> (PoseidonEntity -> PoseidonEntity -> Ordering)
-> (PoseidonEntity -> PoseidonEntity -> Bool)
-> (PoseidonEntity -> PoseidonEntity -> Bool)
-> (PoseidonEntity -> PoseidonEntity -> Bool)
-> (PoseidonEntity -> PoseidonEntity -> Bool)
-> (PoseidonEntity -> PoseidonEntity -> PoseidonEntity)
-> (PoseidonEntity -> PoseidonEntity -> PoseidonEntity)
-> Ord PoseidonEntity
PoseidonEntity -> PoseidonEntity -> Bool
PoseidonEntity -> PoseidonEntity -> Ordering
PoseidonEntity -> PoseidonEntity -> PoseidonEntity
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: PoseidonEntity -> PoseidonEntity -> Ordering
compare :: PoseidonEntity -> PoseidonEntity -> Ordering
$c< :: PoseidonEntity -> PoseidonEntity -> Bool
< :: PoseidonEntity -> PoseidonEntity -> Bool
$c<= :: PoseidonEntity -> PoseidonEntity -> Bool
<= :: PoseidonEntity -> PoseidonEntity -> Bool
$c> :: PoseidonEntity -> PoseidonEntity -> Bool
> :: PoseidonEntity -> PoseidonEntity -> Bool
$c>= :: PoseidonEntity -> PoseidonEntity -> Bool
>= :: PoseidonEntity -> PoseidonEntity -> Bool
$cmax :: PoseidonEntity -> PoseidonEntity -> PoseidonEntity
max :: PoseidonEntity -> PoseidonEntity -> PoseidonEntity
$cmin :: PoseidonEntity -> PoseidonEntity -> PoseidonEntity
min :: PoseidonEntity -> PoseidonEntity -> PoseidonEntity
Ord)

-- | A show instance for rendering entities in forgescript
instance Show PoseidonEntity where
    show :: PoseidonEntity -> String
show (Pac   PacNameAndVersion
p) = PacNameAndVersion -> String
forall a. Show a => a -> String
show PacNameAndVersion
p
    show (Group String
g) = String
g
    show (Ind   String
n) = String
"<" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
n String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
">"
    show (SpecificInd String
n String
g PacNameAndVersion
p) = String
"<" String -> String -> String
forall a. [a] -> [a] -> [a]
++ PacNameAndVersion -> String
forall a. HasNameAndVersion a => a -> String
renderNameWithVersion PacNameAndVersion
p String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
":" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
g String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
":" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
n String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
">"

type EntitiesList = [PoseidonEntity]

-- | a signed entity specification, denoting inclusion or exclusion of an entity
data SignedEntity =
      Include PoseidonEntity
    | Exclude PoseidonEntity
    deriving (SignedEntity -> SignedEntity -> Bool
(SignedEntity -> SignedEntity -> Bool)
-> (SignedEntity -> SignedEntity -> Bool) -> Eq SignedEntity
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SignedEntity -> SignedEntity -> Bool
== :: SignedEntity -> SignedEntity -> Bool
$c/= :: SignedEntity -> SignedEntity -> Bool
/= :: SignedEntity -> SignedEntity -> Bool
Eq, Eq SignedEntity
Eq SignedEntity
-> (SignedEntity -> SignedEntity -> Ordering)
-> (SignedEntity -> SignedEntity -> Bool)
-> (SignedEntity -> SignedEntity -> Bool)
-> (SignedEntity -> SignedEntity -> Bool)
-> (SignedEntity -> SignedEntity -> Bool)
-> (SignedEntity -> SignedEntity -> SignedEntity)
-> (SignedEntity -> SignedEntity -> SignedEntity)
-> Ord SignedEntity
SignedEntity -> SignedEntity -> Bool
SignedEntity -> SignedEntity -> Ordering
SignedEntity -> SignedEntity -> SignedEntity
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: SignedEntity -> SignedEntity -> Ordering
compare :: SignedEntity -> SignedEntity -> Ordering
$c< :: SignedEntity -> SignedEntity -> Bool
< :: SignedEntity -> SignedEntity -> Bool
$c<= :: SignedEntity -> SignedEntity -> Bool
<= :: SignedEntity -> SignedEntity -> Bool
$c> :: SignedEntity -> SignedEntity -> Bool
> :: SignedEntity -> SignedEntity -> Bool
$c>= :: SignedEntity -> SignedEntity -> Bool
>= :: SignedEntity -> SignedEntity -> Bool
$cmax :: SignedEntity -> SignedEntity -> SignedEntity
max :: SignedEntity -> SignedEntity -> SignedEntity
$cmin :: SignedEntity -> SignedEntity -> SignedEntity
min :: SignedEntity -> SignedEntity -> SignedEntity
Ord)

instance Show SignedEntity where
    show :: SignedEntity -> String
show (Include PoseidonEntity
a) = PoseidonEntity -> String
forall a. Show a => a -> String
show PoseidonEntity
a
    show (Exclude PoseidonEntity
a) = String
"-" String -> String -> String
forall a. [a] -> [a] -> [a]
++ PoseidonEntity -> String
forall a. Show a => a -> String
show PoseidonEntity
a

type SignedEntitiesList = [SignedEntity]

-- | A class to generalise signed and unsigned Entity Lists.
--   Both have the feature that they can be used to filter individuals.
class EntitySpec a where
    indInfoConformsToEntitySpec :: IndividualInfo -> Bool -> a -> Maybe Bool
    -- ^ a function to check whether a given individualInfo within a collection of individualInfos matches a given entitySpec.
    -- the second argument specifies whether the package is the latest of all possible packages in the collection
    -- `Nothing` means that the entity has no say about this individual, neither negatively nor positively
    -- `Just True` means that the entity actively selects this individual
    -- `Just False` means that the entity actively unselects this individual
    underlyingEntity :: a -> PoseidonEntity -- ^ returns the unterlying entity
    entitySpecParser :: P.Parser a -- ^ a parser

-- | this function checks whether a given individual info is selected by a given list of entities.

--  The logic is to execute the entitySpecs in order, and then use the last active call to make the decision
indInfoConformsToEntitySpecs :: (EntitySpec a) => IndividualInfo -> Bool -> [a] -> Bool
indInfoConformsToEntitySpecs :: forall a. EntitySpec a => IndividualInfo -> Bool -> [a] -> Bool
indInfoConformsToEntitySpecs IndividualInfo
indInfo Bool
isLatest [a]
entities = case (a -> Maybe Bool) -> [a] -> [Bool]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (IndividualInfo -> Bool -> a -> Maybe Bool
forall a. EntitySpec a => IndividualInfo -> Bool -> a -> Maybe Bool
indInfoConformsToEntitySpec IndividualInfo
indInfo Bool
isLatest) [a]
entities of
    [] -> Bool
False
    [Bool]
xs -> [Bool] -> Bool
forall a. HasCallStack => [a] -> a
last [Bool]
xs

instance EntitySpec SignedEntity where

    -- | Here we specify the exact semantics of all Includes and Excludes for all types of entities.
    -- There are only a few general patterns to exploit. We are specifying them one by one

    -- include Package
    indInfoConformsToEntitySpec :: IndividualInfo -> Bool -> SignedEntity -> Maybe Bool
indInfoConformsToEntitySpec (IndividualInfo String
_ [String]
_ PacNameAndVersion
p1) Bool
isLatest (Include (Pac PacNameAndVersion
p2)) =
        case (PacNameAndVersion
p1, PacNameAndVersion
p2) of
            (PacNameAndVersion String
n1 (Just Version
v1), PacNameAndVersion String
n2 (Just Version
v2)) -> if String
n1 String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
n2 Bool -> Bool -> Bool
&& Version
v1 Version -> Version -> Bool
forall a. Eq a => a -> a -> Bool
== Version
v2 then Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
True else Maybe Bool
forall a. Maybe a
Nothing
            (PacNameAndVersion String
_  Maybe Version
Nothing,   PacNameAndVersion String
_  (Just Version
_ )) -> Maybe Bool
forall a. Maybe a
Nothing
            (PacNameAndVersion String
n1 Maybe Version
_      ,   PacNameAndVersion String
n2 Maybe Version
Nothing  ) -> if String
n1 String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
n2 Bool -> Bool -> Bool
&& Bool
isLatest then Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
True else Maybe Bool
forall a. Maybe a
Nothing

    -- exclude Package
    indInfoConformsToEntitySpec (IndividualInfo String
_ [String]
_ PacNameAndVersion
p1) Bool
_ (Exclude (Pac PacNameAndVersion
p2)) =
        case (PacNameAndVersion
p1, PacNameAndVersion
p2) of
            (PacNameAndVersion String
n1 (Just Version
v1), PacNameAndVersion String
n2 (Just Version
v2)) -> if String
n1 String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
n2 Bool -> Bool -> Bool
&& Version
v1 Version -> Version -> Bool
forall a. Eq a => a -> a -> Bool
== Version
v2 then Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
False else Maybe Bool
forall a. Maybe a
Nothing
            (PacNameAndVersion String
_  Maybe Version
Nothing,   PacNameAndVersion String
_  (Just Version
_ )) -> Maybe Bool
forall a. Maybe a
Nothing
            (PacNameAndVersion String
n1 Maybe Version
_        , PacNameAndVersion String
n2 Maybe Version
Nothing)   -> if String
n1 String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
n2             then Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
False else Maybe Bool
forall a. Maybe a
Nothing

    -- include group
    indInfoConformsToEntitySpec (IndividualInfo String
_ [String]
gs PacNameAndVersion
_) Bool
isLatest (Include (Group String
g)) =
        if String
g String -> [String] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String]
gs Bool -> Bool -> Bool
&& Bool
isLatest then Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
True else Maybe Bool
forall a. Maybe a
Nothing

    -- exclude group
    indInfoConformsToEntitySpec (IndividualInfo String
_ [String]
gs PacNameAndVersion
_) Bool
_ (Exclude (Group String
g)) =
        if String
g String -> [String] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String]
gs then Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
False else Maybe Bool
forall a. Maybe a
Nothing

    -- include general individual
    indInfoConformsToEntitySpec (IndividualInfo String
n1 [String]
_ PacNameAndVersion
_ ) Bool
isLatest (Include (Ind String
n2)) =
        if String
n1 String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
n2 Bool -> Bool -> Bool
&& Bool
isLatest then Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
True else Maybe Bool
forall a. Maybe a
Nothing

    -- exclude general individual
    indInfoConformsToEntitySpec (IndividualInfo String
n1 [String]
_ PacNameAndVersion
_) Bool
_ (Exclude (Ind String
n2)) =
        if String
n1 String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
n2 then Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
False else Maybe Bool
forall a. Maybe a
Nothing

    -- include specific individual
    indInfoConformsToEntitySpec indInfo :: IndividualInfo
indInfo@(IndividualInfo String
n1 [String]
gs PacNameAndVersion
_) Bool
isLatest (Include (SpecificInd String
n2 String
g PacNameAndVersion
p2)) =
        if String
n1 String -> String -> Bool
forall a. Eq a => a -> a -> Bool
/= String
n2 Bool -> Bool -> Bool
|| String
g String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [String]
gs then Maybe Bool
forall a. Maybe a
Nothing else IndividualInfo -> Bool -> SignedEntity -> Maybe Bool
forall a. EntitySpec a => IndividualInfo -> Bool -> a -> Maybe Bool
indInfoConformsToEntitySpec IndividualInfo
indInfo Bool
isLatest (PoseidonEntity -> SignedEntity
Include (PacNameAndVersion -> PoseidonEntity
Pac PacNameAndVersion
p2))

    -- exclude specific individual
    indInfoConformsToEntitySpec indInfo :: IndividualInfo
indInfo@(IndividualInfo String
n1 [String]
gs PacNameAndVersion
_) Bool
isLatest (Exclude (SpecificInd String
n2 String
g PacNameAndVersion
p2)) =
        if String
n1 String -> String -> Bool
forall a. Eq a => a -> a -> Bool
/= String
n2 Bool -> Bool -> Bool
|| String
g String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [String]
gs then Maybe Bool
forall a. Maybe a
Nothing else IndividualInfo -> Bool -> SignedEntity -> Maybe Bool
forall a. EntitySpec a => IndividualInfo -> Bool -> a -> Maybe Bool
indInfoConformsToEntitySpec IndividualInfo
indInfo Bool
isLatest (PoseidonEntity -> SignedEntity
Exclude (PacNameAndVersion -> PoseidonEntity
Pac PacNameAndVersion
p2))

    underlyingEntity :: SignedEntity -> PoseidonEntity
underlyingEntity = SignedEntity -> PoseidonEntity
removeEntitySign

    entitySpecParser :: Parser SignedEntity
entitySpecParser = ParsecT String () Identity (PoseidonEntity -> SignedEntity)
forall {u}.
ParsecT String u Identity (PoseidonEntity -> SignedEntity)
parseSign ParsecT String () Identity (PoseidonEntity -> SignedEntity)
-> ParsecT String () Identity PoseidonEntity -> Parser SignedEntity
forall a b.
ParsecT String () Identity (a -> b)
-> ParsecT String () Identity a -> ParsecT String () Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT String () Identity PoseidonEntity
forall a. EntitySpec a => Parser a
entitySpecParser
      where
        parseSign :: ParsecT String u Identity (PoseidonEntity -> SignedEntity)
parseSign = (Char -> ParsecT String u Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
P.char Char
'-' ParsecT String u Identity Char
-> ParsecT String u Identity (PoseidonEntity -> SignedEntity)
-> ParsecT String u Identity (PoseidonEntity -> SignedEntity)
forall a b.
ParsecT String u Identity a
-> ParsecT String u Identity b -> ParsecT String u Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (PoseidonEntity -> SignedEntity)
-> ParsecT String u Identity (PoseidonEntity -> SignedEntity)
forall a. a -> ParsecT String u Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return PoseidonEntity -> SignedEntity
Exclude) ParsecT String u Identity (PoseidonEntity -> SignedEntity)
-> ParsecT String u Identity (PoseidonEntity -> SignedEntity)
-> ParsecT String u Identity (PoseidonEntity -> SignedEntity)
forall a.
ParsecT String u Identity a
-> ParsecT String u Identity a -> ParsecT String u Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (ParsecT String u Identity Char -> ParsecT String u Identity ()
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m ()
P.optional (Char -> ParsecT String u Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
P.char Char
'+') ParsecT String u Identity ()
-> ParsecT String u Identity (PoseidonEntity -> SignedEntity)
-> ParsecT String u Identity (PoseidonEntity -> SignedEntity)
forall a b.
ParsecT String u Identity a
-> ParsecT String u Identity b -> ParsecT String u Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (PoseidonEntity -> SignedEntity)
-> ParsecT String u Identity (PoseidonEntity -> SignedEntity)
forall a. a -> ParsecT String u Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return PoseidonEntity -> SignedEntity
Include)

instance EntitySpec PoseidonEntity where
    indInfoConformsToEntitySpec :: IndividualInfo -> Bool -> PoseidonEntity -> Maybe Bool
indInfoConformsToEntitySpec IndividualInfo
indInfo Bool
isLatest PoseidonEntity
entity = IndividualInfo -> Bool -> SignedEntity -> Maybe Bool
forall a. EntitySpec a => IndividualInfo -> Bool -> a -> Maybe Bool
indInfoConformsToEntitySpec IndividualInfo
indInfo Bool
isLatest (PoseidonEntity -> SignedEntity
Include PoseidonEntity
entity)
    underlyingEntity :: PoseidonEntity -> PoseidonEntity
underlyingEntity = PoseidonEntity -> PoseidonEntity
forall a. a -> a
id
    entitySpecParser :: ParsecT String () Identity PoseidonEntity
entitySpecParser = ParsecT String () Identity PoseidonEntity
parsePac ParsecT String () Identity PoseidonEntity
-> ParsecT String () Identity PoseidonEntity
-> ParsecT String () Identity PoseidonEntity
forall a.
ParsecT String () Identity a
-> ParsecT String () Identity a -> ParsecT String () Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT String () Identity PoseidonEntity
forall {u}. ParsecT String u Identity PoseidonEntity
parseGroup ParsecT String () Identity PoseidonEntity
-> ParsecT String () Identity PoseidonEntity
-> ParsecT String () Identity PoseidonEntity
forall a.
ParsecT String () Identity a
-> ParsecT String () Identity a -> ParsecT String () Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT String () Identity PoseidonEntity
parseInd
      where
        parsePac :: ParsecT String () Identity PoseidonEntity
parsePac         = PacNameAndVersion -> PoseidonEntity
Pac   (PacNameAndVersion -> PoseidonEntity)
-> ParsecT String () Identity PacNameAndVersion
-> ParsecT String () Identity PoseidonEntity
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT String () Identity Char
-> ParsecT String () Identity Char
-> ParsecT String () Identity PacNameAndVersion
-> ParsecT String () Identity PacNameAndVersion
forall s (m :: * -> *) t u open close a.
Stream s m t =>
ParsecT s u m open
-> ParsecT s u m close -> ParsecT s u m a -> ParsecT s u m a
P.between (Char -> ParsecT String () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
P.char Char
'*') (Char -> ParsecT String () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
P.char Char
'*') ParsecT String () Identity PacNameAndVersion
parseNameAndVer
        parseGroup :: ParsecT String u Identity PoseidonEntity
parseGroup       = String -> PoseidonEntity
Group (String -> PoseidonEntity)
-> ParsecT String u Identity String
-> ParsecT String u Identity PoseidonEntity
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT String u Identity String
forall {u}. ParsecT String u Identity String
parseName
        parseInd :: ParsecT String () Identity PoseidonEntity
parseInd         = ParsecT String () Identity PoseidonEntity
-> ParsecT String () Identity PoseidonEntity
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
P.try ParsecT String () Identity PoseidonEntity
forall {u}. ParsecT String u Identity PoseidonEntity
parseSimpleInd ParsecT String () Identity PoseidonEntity
-> ParsecT String () Identity PoseidonEntity
-> ParsecT String () Identity PoseidonEntity
forall a.
ParsecT String () Identity a
-> ParsecT String () Identity a -> ParsecT String () Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT String () Identity PoseidonEntity
parseSpecificInd
        parseNameAndVer :: ParsecT String () Identity PacNameAndVersion
parseNameAndVer  = do
            String
namePart <- String -> ParsecT String () Identity String
parseNamePart String
""
            Maybe Version
versionPart <- ParsecT String () Identity Version
-> ParsecT String () Identity (Maybe Version)
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m (Maybe a)
P.optionMaybe ParsecT String () Identity Version
parseVersion
            PacNameAndVersion -> ParsecT String () Identity PacNameAndVersion
forall a. a -> ParsecT String () Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (PacNameAndVersion -> ParsecT String () Identity PacNameAndVersion)
-> PacNameAndVersion
-> ParsecT String () Identity PacNameAndVersion
forall a b. (a -> b) -> a -> b
$ String -> Maybe Version -> PacNameAndVersion
PacNameAndVersion String
namePart Maybe Version
versionPart
        parseNamePart :: String -> ParsecT String () Identity String
parseNamePart String
prevPart = do
            String
curPart  <- ParsecT String () Identity Char
-> ParsecT String () Identity String
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
P.many1       ((Char -> Bool) -> ParsecT String () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
(Char -> Bool) -> ParsecT s u m Char
P.satisfy (\Char
c -> Bool -> Bool
not (Char -> Bool
isSpace Char
c Bool -> Bool -> Bool
|| Char
c Char -> String -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Char
':', Char
',', Char
'<', Char
'>', Char
'*', Char
'-'])))
            Maybe Char
nextChar <- ParsecT String () Identity Char
-> ParsecT String () Identity (Maybe Char)
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m (Maybe a)
P.optionMaybe ((Char -> Bool) -> ParsecT String () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
(Char -> Bool) -> ParsecT s u m Char
P.satisfy (\Char
c -> Bool -> Bool
not (Char -> Bool
isSpace Char
c Bool -> Bool -> Bool
|| Char
c Char -> String -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Char
':', Char
',', Char
'<', Char
'>', Char
'*'])))
            case Maybe Char
nextChar of
                Just Char
'-' -> do
                    Bool
isVersionComing <- ParsecT String () Identity Bool
probeForVersion
                    if Bool
isVersionComing
                    then String -> ParsecT String () Identity String
forall a. a -> ParsecT String () Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (String
prevPart String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
curPart)
                    else String -> ParsecT String () Identity String
parseNamePart (String
prevPart String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
curPart String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"-")
                Maybe Char
_ -> String -> ParsecT String () Identity String
forall a. a -> ParsecT String () Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (String
prevPart String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
curPart)
        probeForVersion :: ParsecT String () Identity Bool
probeForVersion  = ParsecT String () Identity Bool -> ParsecT String () Identity Bool
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m a
P.lookAhead (ParsecT String () Identity Version
parseVersion ParsecT String () Identity Version
-> ParsecT String () Identity Bool
-> ParsecT String () Identity Bool
forall a b.
ParsecT String () Identity a
-> ParsecT String () Identity b -> ParsecT String () Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Bool -> ParsecT String () Identity Bool
forall a. a -> ParsecT String () Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True) ParsecT String () Identity Bool
-> ParsecT String () Identity Bool
-> ParsecT String () Identity Bool
forall a.
ParsecT String () Identity a
-> ParsecT String () Identity a -> ParsecT String () Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Bool -> ParsecT String () Identity Bool
forall a. a -> ParsecT String () Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False
        parseName :: ParsecT String u Identity String
parseName        = ParsecT String u Identity Char -> ParsecT String u Identity String
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
P.many1 ((Char -> Bool) -> ParsecT String u Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
(Char -> Bool) -> ParsecT s u m Char
P.satisfy (\Char
c -> Bool -> Bool
not (Char -> Bool
isSpace Char
c Bool -> Bool -> Bool
|| Char
c Char -> String -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Char
':', Char
',', Char
'<', Char
'>', Char
'*'])))
        parseSimpleInd :: ParsecT String u Identity PoseidonEntity
parseSimpleInd   = String -> PoseidonEntity
Ind (String -> PoseidonEntity)
-> ParsecT String u Identity String
-> ParsecT String u Identity PoseidonEntity
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT String u Identity Char
-> ParsecT String u Identity Char
-> ParsecT String u Identity String
-> ParsecT String u Identity String
forall s (m :: * -> *) t u open close a.
Stream s m t =>
ParsecT s u m open
-> ParsecT s u m close -> ParsecT s u m a -> ParsecT s u m a
P.between (Char -> ParsecT String u Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
P.char Char
'<') (Char -> ParsecT String u Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
P.char Char
'>') ParsecT String u Identity String
forall {u}. ParsecT String u Identity String
parseName
        parseSpecificInd :: ParsecT String () Identity PoseidonEntity
parseSpecificInd = do
            Char
_ <- Char -> ParsecT String () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
P.char Char
'<'
            PacNameAndVersion
pac <- ParsecT String () Identity PacNameAndVersion
parseNameAndVer
            Char
_ <- Char -> ParsecT String () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
P.char Char
':'
            String
groupName <- ParsecT String () Identity String
forall {u}. ParsecT String u Identity String
parseName
            Char
_ <- Char -> ParsecT String () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
P.char Char
':'
            String
indName <- ParsecT String () Identity String
forall {u}. ParsecT String u Identity String
parseName
            Char
_ <- Char -> ParsecT String () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
P.char Char
'>'
            PoseidonEntity -> ParsecT String () Identity PoseidonEntity
forall a. a -> ParsecT String () Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (PoseidonEntity -> ParsecT String () Identity PoseidonEntity)
-> PoseidonEntity -> ParsecT String () Identity PoseidonEntity
forall a b. (a -> b) -> a -> b
$ String -> String -> PacNameAndVersion -> PoseidonEntity
SpecificInd String
indName String
groupName PacNameAndVersion
pac

-- turns out that we cannot easily write instances for classes, so need to be explicit for both types
instance FromJSON PoseidonEntity where parseJSON :: Value -> Parser PoseidonEntity
parseJSON = String
-> (Text -> Parser PoseidonEntity)
-> Value
-> Parser PoseidonEntity
forall a. String -> (Text -> Parser a) -> Value -> Parser a
withText String
"PoseidonEntity" Text -> Parser PoseidonEntity
forall e. EntitySpec e => Text -> Parser e
aesonParseEntitySpec
instance FromJSON SignedEntity   where parseJSON :: Value -> Parser SignedEntity
parseJSON = String
-> (Text -> Parser SignedEntity) -> Value -> Parser SignedEntity
forall a. String -> (Text -> Parser a) -> Value -> Parser a
withText String
"SignedEntity" Text -> Parser SignedEntity
forall e. EntitySpec e => Text -> Parser e
aesonParseEntitySpec
instance ToJSON   PoseidonEntity where toJSON :: PoseidonEntity -> Value
toJSON PoseidonEntity
e = Text -> Value
String (String -> Text
pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ PoseidonEntity -> String
forall a. Show a => a -> String
show PoseidonEntity
e)
instance ToJSON   SignedEntity   where toJSON :: SignedEntity -> Value
toJSON SignedEntity
e = Text -> Value
String (String -> Text
pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ SignedEntity -> String
forall a. Show a => a -> String
show SignedEntity
e)

aesonParseEntitySpec :: (EntitySpec e) => Text -> Parser e
aesonParseEntitySpec :: forall e. EntitySpec e => Text -> Parser e
aesonParseEntitySpec Text
t = case Parsec String () e -> () -> String -> String -> Either ParseError e
forall s t u a.
Stream s Identity t =>
Parsec s u a -> u -> String -> s -> Either ParseError a
P.runParser Parsec String () e
forall a. EntitySpec a => Parser a
entitySpecParser () String
"" (Text -> String
unpack Text
t) of
    Left ParseError
err -> String -> Parser e
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser e) -> String -> Parser e
forall a b. (a -> b) -> a -> b
$ ParseError -> String
showParsecErr ParseError
err
    Right e
p' -> e -> Parser e
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return e
p'

-- | a minimal datatype representing an individual in a collection of packages
data IndividualInfo = IndividualInfo
    { IndividualInfo -> String
indInfoName   :: String -- ^ the name of the individual, corresponding to jPoseidonID in Janno
    , IndividualInfo -> [String]
indInfoGroups :: [String] -- ^ the groups associated with the individual, corresponding to jGroupName in Janno
    , IndividualInfo -> PacNameAndVersion
indInfoPac    :: PacNameAndVersion -- ^ the package the individual is in.
    } deriving (Int -> IndividualInfo -> String -> String
[IndividualInfo] -> String -> String
IndividualInfo -> String
(Int -> IndividualInfo -> String -> String)
-> (IndividualInfo -> String)
-> ([IndividualInfo] -> String -> String)
-> Show IndividualInfo
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
$cshowsPrec :: Int -> IndividualInfo -> String -> String
showsPrec :: Int -> IndividualInfo -> String -> String
$cshow :: IndividualInfo -> String
show :: IndividualInfo -> String
$cshowList :: [IndividualInfo] -> String -> String
showList :: [IndividualInfo] -> String -> String
Show, IndividualInfo -> IndividualInfo -> Bool
(IndividualInfo -> IndividualInfo -> Bool)
-> (IndividualInfo -> IndividualInfo -> Bool) -> Eq IndividualInfo
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: IndividualInfo -> IndividualInfo -> Bool
== :: IndividualInfo -> IndividualInfo -> Bool
$c/= :: IndividualInfo -> IndividualInfo -> Bool
/= :: IndividualInfo -> IndividualInfo -> Bool
Eq, Eq IndividualInfo
Eq IndividualInfo
-> (IndividualInfo -> IndividualInfo -> Ordering)
-> (IndividualInfo -> IndividualInfo -> Bool)
-> (IndividualInfo -> IndividualInfo -> Bool)
-> (IndividualInfo -> IndividualInfo -> Bool)
-> (IndividualInfo -> IndividualInfo -> Bool)
-> (IndividualInfo -> IndividualInfo -> IndividualInfo)
-> (IndividualInfo -> IndividualInfo -> IndividualInfo)
-> Ord IndividualInfo
IndividualInfo -> IndividualInfo -> Bool
IndividualInfo -> IndividualInfo -> Ordering
IndividualInfo -> IndividualInfo -> IndividualInfo
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: IndividualInfo -> IndividualInfo -> Ordering
compare :: IndividualInfo -> IndividualInfo -> Ordering
$c< :: IndividualInfo -> IndividualInfo -> Bool
< :: IndividualInfo -> IndividualInfo -> Bool
$c<= :: IndividualInfo -> IndividualInfo -> Bool
<= :: IndividualInfo -> IndividualInfo -> Bool
$c> :: IndividualInfo -> IndividualInfo -> Bool
> :: IndividualInfo -> IndividualInfo -> Bool
$c>= :: IndividualInfo -> IndividualInfo -> Bool
>= :: IndividualInfo -> IndividualInfo -> Bool
$cmax :: IndividualInfo -> IndividualInfo -> IndividualInfo
max :: IndividualInfo -> IndividualInfo -> IndividualInfo
$cmin :: IndividualInfo -> IndividualInfo -> IndividualInfo
min :: IndividualInfo -> IndividualInfo -> IndividualInfo
Ord, (forall x. IndividualInfo -> Rep IndividualInfo x)
-> (forall x. Rep IndividualInfo x -> IndividualInfo)
-> Generic IndividualInfo
forall x. Rep IndividualInfo x -> IndividualInfo
forall x. IndividualInfo -> Rep IndividualInfo x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. IndividualInfo -> Rep IndividualInfo x
from :: forall x. IndividualInfo -> Rep IndividualInfo x
$cto :: forall x. Rep IndividualInfo x -> IndividualInfo
to :: forall x. Rep IndividualInfo x -> IndividualInfo
Generic)

instance HasNameAndVersion IndividualInfo where
    getPacName :: IndividualInfo -> String
getPacName       = PacNameAndVersion -> String
forall a. HasNameAndVersion a => a -> String
getPacName (PacNameAndVersion -> String)
-> (IndividualInfo -> PacNameAndVersion)
-> IndividualInfo
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IndividualInfo -> PacNameAndVersion
indInfoPac
    getPacVersion :: IndividualInfo -> Maybe Version
getPacVersion    = PacNameAndVersion -> Maybe Version
forall a. HasNameAndVersion a => a -> Maybe Version
getPacVersion (PacNameAndVersion -> Maybe Version)
-> (IndividualInfo -> PacNameAndVersion)
-> IndividualInfo
-> Maybe Version
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IndividualInfo -> PacNameAndVersion
indInfoPac

-- | a tuple of a collection of IndividualInfos and a list of bools
--   indicating whether the given sample is in the latest version of packages
type IndividualInfoCollection = ([IndividualInfo], [Bool])

-- data types for the selection process

data EntityInput a = EntitiesDirect [a] | EntitiesFromFile FilePath -- an empty list is interpreted as "all packages"

-- | determine all packages with versions that contain individuals covered by the given entities
determineRelevantPackages :: (MonadThrow m, EntitySpec a) => [a] -> IndividualInfoCollection -> m [PacNameAndVersion]
determineRelevantPackages :: forall (m :: * -> *) a.
(MonadThrow m, EntitySpec a) =>
[a] -> IndividualInfoCollection -> m [PacNameAndVersion]
determineRelevantPackages [a]
entities ([IndividualInfo]
indInfos, [Bool]
areLatest) = do
    let relevantPacs :: [PacNameAndVersion]
relevantPacs = [ IndividualInfo -> PacNameAndVersion
indInfoPac IndividualInfo
ind | (IndividualInfo
ind, Bool
l) <- [IndividualInfo] -> [Bool] -> [(IndividualInfo, Bool)]
forall a b. [a] -> [b] -> [(a, b)]
zip [IndividualInfo]
indInfos [Bool]
areLatest, IndividualInfo -> Bool -> [a] -> Bool
forall a. EntitySpec a => IndividualInfo -> Bool -> [a] -> Bool
indInfoConformsToEntitySpecs IndividualInfo
ind Bool
l [a]
entities ]
    [PacNameAndVersion] -> m [PacNameAndVersion]
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ([PacNameAndVersion] -> m [PacNameAndVersion])
-> ([PacNameAndVersion] -> [PacNameAndVersion])
-> [PacNameAndVersion]
-> m [PacNameAndVersion]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [PacNameAndVersion] -> [PacNameAndVersion]
forall a. Eq a => [a] -> [a]
nub ([PacNameAndVersion] -> [PacNameAndVersion])
-> ([PacNameAndVersion] -> [PacNameAndVersion])
-> [PacNameAndVersion]
-> [PacNameAndVersion]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PacNameAndVersion -> PacNameAndVersion)
-> [PacNameAndVersion] -> [PacNameAndVersion]
forall a b. (a -> b) -> [a] -> [b]
map PacNameAndVersion -> PacNameAndVersion
forall a. HasNameAndVersion a => a -> PacNameAndVersion
makePacNameAndVersion ([PacNameAndVersion] -> m [PacNameAndVersion])
-> [PacNameAndVersion] -> m [PacNameAndVersion]
forall a b. (a -> b) -> a -> b
$ [PacNameAndVersion]
relevantPacs

-- | takes a list of selected individuals, checks for duplicates and reports a list of individuals with suggested Entity specifications
reportDuplicateIndividuals :: [IndividualInfo] -> [(IndividualInfo, [PoseidonEntity])]
reportDuplicateIndividuals :: [IndividualInfo] -> [(IndividualInfo, [PoseidonEntity])]
reportDuplicateIndividuals [IndividualInfo]
individuals = do -- loop over duplication groups
    duplicateGroup :: [IndividualInfo]
duplicateGroup@(IndividualInfo
firstInd : [IndividualInfo]
_) <- ([IndividualInfo] -> Bool)
-> [[IndividualInfo]] -> [[IndividualInfo]]
forall a. (a -> Bool) -> [a] -> [a]
filter ((Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>Int
1) (Int -> Bool)
-> ([IndividualInfo] -> Int) -> [IndividualInfo] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [IndividualInfo] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length) ([[IndividualInfo]] -> [[IndividualInfo]])
-> ([IndividualInfo] -> [[IndividualInfo]])
-> [IndividualInfo]
-> [[IndividualInfo]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (IndividualInfo -> IndividualInfo -> Bool)
-> [IndividualInfo] -> [[IndividualInfo]]
forall a. (a -> a -> Bool) -> [a] -> [[a]]
groupBy (\IndividualInfo
a IndividualInfo
b -> IndividualInfo -> String
indInfoName IndividualInfo
a String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== IndividualInfo -> String
indInfoName IndividualInfo
b) ([IndividualInfo] -> [[IndividualInfo]])
-> ([IndividualInfo] -> [IndividualInfo])
-> [IndividualInfo]
-> [[IndividualInfo]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (IndividualInfo -> String) -> [IndividualInfo] -> [IndividualInfo]
forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn IndividualInfo -> String
indInfoName ([IndividualInfo] -> [[IndividualInfo]])
-> [IndividualInfo] -> [[IndividualInfo]]
forall a b. (a -> b) -> a -> b
$ [IndividualInfo]
individuals
    (IndividualInfo, [PoseidonEntity])
-> [(IndividualInfo, [PoseidonEntity])]
forall a. a -> [a]
forall (m :: * -> *) a. Monad m => a -> m a
return (IndividualInfo
firstInd, [String -> String -> PacNameAndVersion -> PoseidonEntity
SpecificInd String
n' ([String] -> String
forall a. HasCallStack => [a] -> a
head [String]
g) PacNameAndVersion
p | IndividualInfo String
n' [String]
g PacNameAndVersion
p <- [IndividualInfo]
duplicateGroup])

resolveEntityIndices :: (EntitySpec a) => Bool -> [a] -> IndividualInfoCollection -> [Int]
resolveEntityIndices :: forall a.
EntitySpec a =>
Bool -> [a] -> IndividualInfoCollection -> [Int]
resolveEntityIndices Bool
True  = [a] -> IndividualInfoCollection -> [Int]
forall a. EntitySpec a => [a] -> IndividualInfoCollection -> [Int]
resolveEntityIndicesOrdered
resolveEntityIndices Bool
False = [a] -> IndividualInfoCollection -> [Int]
forall a. EntitySpec a => [a] -> IndividualInfoCollection -> [Int]
resolveEntityIndicesUnordered

-- | this finds the indices of all individuals from an individual-list which are specified in the Entity list
resolveEntityIndicesUnordered :: (EntitySpec a) => [a] -> IndividualInfoCollection -> [Int]
resolveEntityIndicesUnordered :: forall a. EntitySpec a => [a] -> IndividualInfoCollection -> [Int]
resolveEntityIndicesUnordered [a]
entities ([IndividualInfo]
indInfos, [Bool]
areLatest) =
    [ Int
i | (Int
i, IndividualInfo
ind, Bool
l) <- [Int]
-> [IndividualInfo] -> [Bool] -> [(Int, IndividualInfo, Bool)]
forall a b c. [a] -> [b] -> [c] -> [(a, b, c)]
zip3 [Int
0..] [IndividualInfo]
indInfos [Bool]
areLatest, IndividualInfo -> Bool -> [a] -> Bool
forall a. EntitySpec a => IndividualInfo -> Bool -> [a] -> Bool
indInfoConformsToEntitySpecs IndividualInfo
ind Bool
l [a]
entities ]

-- | this finds the indices of all individuals from an individual-list which are specified in the Entity list, ordered by the entity list
resolveEntityIndicesOrdered :: (EntitySpec a) => [a] -> IndividualInfoCollection -> [Int]
resolveEntityIndicesOrdered :: forall a. EntitySpec a => [a] -> IndividualInfoCollection -> [Int]
resolveEntityIndicesOrdered [a]
entities ([IndividualInfo]
indInfos, [Bool]
areLatest) = [Int] -> [a] -> [Int]
forall a. EntitySpec a => [Int] -> [a] -> [Int]
go [] [a]
entities
  where
    go :: (EntitySpec a) => [Int] -> [a] -> [Int]
    go :: forall a. EntitySpec a => [Int] -> [a] -> [Int]
go [Int]
selectedIndices [] = [Int]
selectedIndices
    go [Int]
selectedIndices (a
entity:[a]
restEntities)=
        -- We first check whether any already selected indices are removed due to the new entity (can happen if the entity is signed and negative)
        let selectedInds :: [IndividualInfo]
selectedInds   = (Int -> IndividualInfo) -> [Int] -> [IndividualInfo]
forall a b. (a -> b) -> [a] -> [b]
map ([IndividualInfo]
indInfos[IndividualInfo] -> Int -> IndividualInfo
forall a. HasCallStack => [a] -> Int -> a
!!) [Int]
selectedIndices
            selectedLatest :: [Bool]
selectedLatest = (Int -> Bool) -> [Int] -> [Bool]
forall a b. (a -> b) -> [a] -> [b]
map ([Bool]
areLatest[Bool] -> Int -> Bool
forall a. HasCallStack => [a] -> Int -> a
!!) [Int]
selectedIndices
            selectedUpdated :: [Int]
selectedUpdated = [Int
i | (Int
i, IndividualInfo
ind, Bool
l) <- [Int]
-> [IndividualInfo] -> [Bool] -> [(Int, IndividualInfo, Bool)]
forall a b c. [a] -> [b] -> [c] -> [(a, b, c)]
zip3 [Int]
selectedIndices [IndividualInfo]
selectedInds [Bool]
selectedLatest, IndividualInfo -> Bool -> a -> Maybe Bool
forall a. EntitySpec a => IndividualInfo -> Bool -> a -> Maybe Bool
indInfoConformsToEntitySpec IndividualInfo
ind Bool
l a
entity Maybe Bool -> Maybe Bool -> Bool
forall a. Eq a => a -> a -> Bool
/= Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
False]
            -- We then check which indices are found according to the new entity...
            additionalIndicesAll :: [Int]
additionalIndicesAll = [ Int
i | (Int
i, IndividualInfo
ind, Bool
l) <- [Int]
-> [IndividualInfo] -> [Bool] -> [(Int, IndividualInfo, Bool)]
forall a b c. [a] -> [b] -> [c] -> [(a, b, c)]
zip3 [Int
0..] [IndividualInfo]
indInfos [Bool]
areLatest, IndividualInfo -> Bool -> a -> Maybe Bool
forall a. EntitySpec a => IndividualInfo -> Bool -> a -> Maybe Bool
indInfoConformsToEntitySpec IndividualInfo
ind Bool
l a
entity Maybe Bool -> Maybe Bool -> Bool
forall a. Eq a => a -> a -> Bool
== Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
True]
            -- ... and use only the ones that are not already selected:
            additionalIndicesNew :: [Int]
additionalIndicesNew = [Int]
additionalIndicesAll [Int] -> [Int] -> [Int]
forall a. Eq a => [a] -> [a] -> [a]
\\ [Int]
selectedUpdated
        in  [Int] -> [a] -> [Int]
forall a. EntitySpec a => [Int] -> [a] -> [Int]
go ([Int]
selectedUpdated [Int] -> [Int] -> [Int]
forall a. [a] -> [a] -> [a]
++ [Int]
additionalIndicesNew) [a]
restEntities

resolveUniqueEntityIndices :: (EntitySpec a) => Bool -> [a] -> IndividualInfoCollection -> PoseidonIO [Int]
resolveUniqueEntityIndices :: forall a.
EntitySpec a =>
Bool -> [a] -> IndividualInfoCollection -> PoseidonIO [Int]
resolveUniqueEntityIndices Bool
isOrdered [a]
entities IndividualInfoCollection
indInfoCollection = do
    let relevantIndices :: [Int]
relevantIndices = Bool -> [a] -> IndividualInfoCollection -> [Int]
forall a.
EntitySpec a =>
Bool -> [a] -> IndividualInfoCollection -> [Int]
resolveEntityIndices Bool
isOrdered [a]
entities IndividualInfoCollection
indInfoCollection
    let duplicateReport :: [(IndividualInfo, [PoseidonEntity])]
duplicateReport = [IndividualInfo] -> [(IndividualInfo, [PoseidonEntity])]
reportDuplicateIndividuals ([IndividualInfo] -> [(IndividualInfo, [PoseidonEntity])])
-> ([Int] -> [IndividualInfo])
-> [Int]
-> [(IndividualInfo, [PoseidonEntity])]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> IndividualInfo) -> [Int] -> [IndividualInfo]
forall a b. (a -> b) -> [a] -> [b]
map ((IndividualInfoCollection -> [IndividualInfo]
forall a b. (a, b) -> a
fst IndividualInfoCollection
indInfoCollection) [IndividualInfo] -> Int -> IndividualInfo
forall a. HasCallStack => [a] -> Int -> a
!!) ([Int] -> [(IndividualInfo, [PoseidonEntity])])
-> [Int] -> [(IndividualInfo, [PoseidonEntity])]
forall a b. (a -> b) -> a -> b
$ [Int]
relevantIndices
    -- check if there still are duplicates and if yes, then stop
    Bool -> ReaderT Env IO () -> ReaderT Env IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([(IndividualInfo, [PoseidonEntity])] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(IndividualInfo, [PoseidonEntity])]
duplicateReport) (ReaderT Env IO () -> ReaderT Env IO ())
-> ReaderT Env IO () -> ReaderT Env IO ()
forall a b. (a -> b) -> a -> b
$ do
        String -> ReaderT Env IO ()
logError String
"There are duplicated individuals, but forge does not allow that"
        String -> ReaderT Env IO ()
logError String
"Please specify in your --forgeString or --forgeFile:"
        [(IndividualInfo, [PoseidonEntity])]
-> ((IndividualInfo, [PoseidonEntity]) -> ReaderT Env IO ())
-> ReaderT Env IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [(IndividualInfo, [PoseidonEntity])]
duplicateReport (((IndividualInfo, [PoseidonEntity]) -> ReaderT Env IO ())
 -> ReaderT Env IO ())
-> ((IndividualInfo, [PoseidonEntity]) -> ReaderT Env IO ())
-> ReaderT Env IO ()
forall a b. (a -> b) -> a -> b
$ \(IndividualInfo String
n [String]
_ PacNameAndVersion
_, [PoseidonEntity]
specs) -> do
            String -> ReaderT Env IO ()
logError (String -> ReaderT Env IO ()) -> String -> ReaderT Env IO ()
forall a b. (a -> b) -> a -> b
$ String
"Duplicate individual " String -> String -> String
forall a. [a] -> [a] -> [a]
++ PoseidonEntity -> String
forall a. Show a => a -> String
show (String -> PoseidonEntity
Ind String
n) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" (please specify)"
            [PoseidonEntity]
-> (PoseidonEntity -> ReaderT Env IO ()) -> ReaderT Env IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [PoseidonEntity]
specs ((PoseidonEntity -> ReaderT Env IO ()) -> ReaderT Env IO ())
-> (PoseidonEntity -> ReaderT Env IO ()) -> ReaderT Env IO ()
forall a b. (a -> b) -> a -> b
$ \PoseidonEntity
spec -> do
                String -> ReaderT Env IO ()
logError (String -> ReaderT Env IO ()) -> String -> ReaderT Env IO ()
forall a b. (a -> b) -> a -> b
$ String
"  " String -> String -> String
forall a. [a] -> [a] -> [a]
++ PoseidonEntity -> String
forall a. Show a => a -> String
show (String -> PoseidonEntity
Ind String
n) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" -> " String -> String -> String
forall a. [a] -> [a] -> [a]
++ PoseidonEntity -> String
forall a. Show a => a -> String
show PoseidonEntity
spec
        IO () -> ReaderT Env IO ()
forall a. IO a -> ReaderT Env IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ReaderT Env IO ()) -> IO () -> ReaderT Env IO ()
forall a b. (a -> b) -> a -> b
$ PoseidonException -> IO ()
forall e a. Exception e => e -> IO a
throwIO (PoseidonException -> IO ()) -> PoseidonException -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> PoseidonException
PoseidonForgeEntitiesException String
"Unresolved duplicated individuals"
    [Int] -> PoseidonIO [Int]
forall a. a -> ReaderT Env IO a
forall (m :: * -> *) a. Monad m => a -> m a
return [Int]
relevantIndices

-- | this returns a list of entities which could not be found
determineNonExistentEntities :: (EntitySpec a) => [a] -> IndividualInfoCollection -> EntitiesList
determineNonExistentEntities :: forall a.
EntitySpec a =>
[a] -> IndividualInfoCollection -> [PoseidonEntity]
determineNonExistentEntities [a]
entities IndividualInfoCollection
indInfoCollection =
    [ PoseidonEntity
entity | PoseidonEntity
entity <- (a -> PoseidonEntity) -> [a] -> [PoseidonEntity]
forall a b. (a -> b) -> [a] -> [b]
map a -> PoseidonEntity
forall a. EntitySpec a => a -> PoseidonEntity
underlyingEntity [a]
entities, [Int] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (Bool -> [PoseidonEntity] -> IndividualInfoCollection -> [Int]
forall a.
EntitySpec a =>
Bool -> [a] -> IndividualInfoCollection -> [Int]
resolveEntityIndices Bool
False [PoseidonEntity
entity] IndividualInfoCollection
indInfoCollection)]

checkIfAllEntitiesExist :: (EntitySpec a) => [a] -> IndividualInfoCollection -> PoseidonIO ()
checkIfAllEntitiesExist :: forall a.
EntitySpec a =>
[a] -> IndividualInfoCollection -> ReaderT Env IO ()
checkIfAllEntitiesExist [a]
entities IndividualInfoCollection
indInfoCollection = do
    let nonExistentEntities :: [PoseidonEntity]
nonExistentEntities = [a] -> IndividualInfoCollection -> [PoseidonEntity]
forall a.
EntitySpec a =>
[a] -> IndividualInfoCollection -> [PoseidonEntity]
determineNonExistentEntities [a]
entities IndividualInfoCollection
indInfoCollection
    Bool -> ReaderT Env IO () -> ReaderT Env IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([PoseidonEntity] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [PoseidonEntity]
nonExistentEntities) (ReaderT Env IO () -> ReaderT Env IO ())
-> ReaderT Env IO () -> ReaderT Env IO ()
forall a b. (a -> b) -> a -> b
$ do
        String -> ReaderT Env IO ()
logError String
"The following entities could not be found in the dataset"
        [PoseidonEntity]
-> (PoseidonEntity -> ReaderT Env IO ()) -> ReaderT Env IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [PoseidonEntity]
nonExistentEntities (String -> ReaderT Env IO ()
logError (String -> ReaderT Env IO ())
-> (PoseidonEntity -> String)
-> PoseidonEntity
-> ReaderT Env IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PoseidonEntity -> String
forall a. Show a => a -> String
show)
        String -> ReaderT Env IO ()
logError String
"Maybe these entities exist in older package versions?"
        IO () -> ReaderT Env IO ()
forall a. IO a -> ReaderT Env IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ReaderT Env IO ())
-> (PoseidonException -> IO ())
-> PoseidonException
-> ReaderT Env IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PoseidonException -> IO ()
forall e a. Exception e => e -> IO a
throwIO (PoseidonException -> ReaderT Env IO ())
-> PoseidonException -> ReaderT Env IO ()
forall a b. (a -> b) -> a -> b
$ String -> PoseidonException
PoseidonForgeEntitiesException String
"some entities do not exist"

-- parsing code to read entities from files
readEntitiesFromString :: (EntitySpec a) => String -> Either PoseidonException [a]
readEntitiesFromString :: forall a. EntitySpec a => String -> Either PoseidonException [a]
readEntitiesFromString String
s = case Parsec String () [a]
-> () -> String -> String -> Either ParseError [a]
forall s t u a.
Stream s Identity t =>
Parsec s u a -> u -> String -> s -> Either ParseError a
P.runParser (Parsec String () [a]
forall a. EntitySpec a => Parser [a]
entitiesListP Parsec String () [a]
-> ParsecT String () Identity () -> Parsec String () [a]
forall a b.
ParsecT String () Identity a
-> ParsecT String () Identity b -> ParsecT String () Identity a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT String () Identity ()
forall s (m :: * -> *) t u.
(Stream s m t, Show t) =>
ParsecT s u m ()
P.eof) () String
"" String
s of
    Left ParseError
p  -> PoseidonException -> Either PoseidonException [a]
forall a b. a -> Either a b
Left (PoseidonException -> Either PoseidonException [a])
-> PoseidonException -> Either PoseidonException [a]
forall a b. (a -> b) -> a -> b
$ ParseError -> PoseidonException
PoseidonPoseidonEntityParsingException ParseError
p
    Right [a]
x -> [a] -> Either PoseidonException [a]
forall a b. b -> Either a b
Right [a]
x

readEntityInputs :: (MonadIO m, EntitySpec a, Eq a) => [EntityInput a] -> m [a] -- An empty list means that entities are wanted.
readEntityInputs :: forall (m :: * -> *) a.
(MonadIO m, EntitySpec a, Eq a) =>
[EntityInput a] -> m [a]
readEntityInputs [EntityInput a]
entityInputs =
    ([[a]] -> [a]) -> m [[a]] -> m [a]
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ([a] -> [a]
forall a. Eq a => [a] -> [a]
nub ([a] -> [a]) -> ([[a]] -> [a]) -> [[a]] -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[a]] -> [a]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat) (m [[a]] -> m [a])
-> ((EntityInput a -> m [a]) -> m [[a]])
-> (EntityInput a -> m [a])
-> m [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [EntityInput a] -> (EntityInput a -> m [a]) -> m [[a]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [EntityInput a]
entityInputs ((EntityInput a -> m [a]) -> m [a])
-> (EntityInput a -> m [a]) -> m [a]
forall a b. (a -> b) -> a -> b
$ \EntityInput a
entityInput -> case EntityInput a
entityInput of
        EntitiesDirect   [a]
e  -> [a] -> m [a]
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return [a]
e
        EntitiesFromFile String
fp -> IO [a] -> m [a]
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [a] -> m [a]) -> IO [a] -> m [a]
forall a b. (a -> b) -> a -> b
$ String -> IO [a]
forall a. EntitySpec a => String -> IO [a]
readEntitiesFromFile String
fp

removeEntitySign :: SignedEntity -> PoseidonEntity
removeEntitySign :: SignedEntity -> PoseidonEntity
removeEntitySign (Include PoseidonEntity
e) = PoseidonEntity
e
removeEntitySign (Exclude PoseidonEntity
e) = PoseidonEntity
e

entitiesListP :: (EntitySpec a) => P.Parser [a]
entitiesListP :: forall a. EntitySpec a => Parser [a]
entitiesListP = ParsecT String () Identity a
-> ParsecT String () Identity Char
-> ParsecT String () Identity [a]
forall s (m :: * -> *) t u a sep.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m sep -> ParsecT s u m [a]
P.sepBy ParsecT String () Identity a
forall a. EntitySpec a => Parser a
entitySpecParser (Char -> ParsecT String () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
P.char Char
',' ParsecT String () Identity Char
-> ParsecT String () Identity () -> ParsecT String () Identity Char
forall a b.
ParsecT String () Identity a
-> ParsecT String () Identity b -> ParsecT String () Identity a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT String () Identity ()
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
P.spaces)

entitiesListMultilineP :: (EntitySpec a) => P.Parser [a]
entitiesListMultilineP :: forall a. EntitySpec a => Parser [a]
entitiesListMultilineP = do
    [[a]] -> [a]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[a]] -> [a]) -> ParsecT String () Identity [[a]] -> Parser [a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser [a]
-> ParsecT String () Identity Char
-> ParsecT String () Identity [[a]]
forall s (m :: * -> *) t u a sep.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m sep -> ParsecT s u m [a]
P.sepBy (Parser [a] -> Parser [a]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
P.try Parser [a]
forall a. EntitySpec a => Parser [a]
emptyLineP Parser [a] -> Parser [a] -> Parser [a]
forall a.
ParsecT String () Identity a
-> ParsecT String () Identity a -> ParsecT String () Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser [a]
forall a. EntitySpec a => Parser [a]
commentP Parser [a] -> Parser [a] -> Parser [a]
forall a.
ParsecT String () Identity a
-> ParsecT String () Identity a -> ParsecT String () Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser [a]
entitiesListWithCommentsP) ParsecT String () Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
P.newline
  where
    entitiesListWithCommentsP :: Parser [a]
entitiesListWithCommentsP = do
        [a]
eL <- Parser [a]
forall a. EntitySpec a => Parser [a]
entitiesListP
        String
_ <- ParsecT String () Identity Char
-> ParsecT String () Identity String
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
P.many (Char -> ParsecT String () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
P.char Char
' ')
        ()
_ <- ParsecT String () Identity [PoseidonEntity]
-> ParsecT String () Identity ()
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m ()
P.optional (ParsecT String () Identity [PoseidonEntity]
forall a. EntitySpec a => Parser [a]
commentP :: P.Parser EntitiesList) -- compiler complains about unambiguous type without this redundant type annotation
        [a] -> Parser [a]
forall a. a -> ParsecT String () Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return [a]
eL

emptyLineP :: (EntitySpec a) => P.Parser [a]
emptyLineP :: forall a. EntitySpec a => Parser [a]
emptyLineP = do
    String
_ <- ParsecT String () Identity Char
-> ParsecT String () Identity Char
-> ParsecT String () Identity String
forall s (m :: * -> *) t u a sep.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m sep -> ParsecT s u m [a]
P.manyTill (Char -> ParsecT String () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
P.char Char
' ') (ParsecT String () Identity Char -> ParsecT String () Identity Char
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m a
P.lookAhead ParsecT String () Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
P.newline)
    [a] -> Parser [a]
forall a. a -> ParsecT String () Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return []

commentP :: (EntitySpec a) => P.Parser [a]
commentP :: forall a. EntitySpec a => Parser [a]
commentP = do
    String
_ <- String -> ParsecT String () Identity String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
P.string String
"#"
    String
_ <- ParsecT String () Identity Char
-> ParsecT String () Identity Char
-> ParsecT String () Identity String
forall s (m :: * -> *) t u a sep.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m sep -> ParsecT s u m [a]
P.manyTill ParsecT String () Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
P.anyChar (ParsecT String () Identity Char -> ParsecT String () Identity Char
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m a
P.lookAhead ParsecT String () Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
P.newline)
    [a] -> Parser [a]
forall a. a -> ParsecT String () Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return []

readEntitiesFromFile :: (EntitySpec a) => FilePath -> IO [a]
readEntitiesFromFile :: forall a. EntitySpec a => String -> IO [a]
readEntitiesFromFile String
entitiesFile = do
    Either ParseError [a]
eitherParseResult <- Parser [a] -> String -> IO (Either ParseError [a])
forall a. Parser a -> String -> IO (Either ParseError a)
P.parseFromFile (Parser [a]
forall a. EntitySpec a => Parser [a]
entitiesListMultilineP Parser [a] -> ParsecT String () Identity () -> Parser [a]
forall a b.
ParsecT String () Identity a
-> ParsecT String () Identity b -> ParsecT String () Identity a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT String () Identity ()
forall s (m :: * -> *) t u.
(Stream s m t, Show t) =>
ParsecT s u m ()
P.eof) String
entitiesFile
    case Either ParseError [a]
eitherParseResult of
        Left ParseError
e  -> PoseidonException -> IO [a]
forall e a. Exception e => e -> IO a
throwIO (ParseError -> PoseidonException
PoseidonPoseidonEntityParsingException ParseError
e)
        Right [a]
r -> [a] -> IO [a]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return [a]
r