-- | Types (and a few other simple definitions) for futhark-pkg.
module Futhark.Pkg.Types
  ( PkgPath,
    pkgPathFilePath,
    PkgRevDeps (..),
    module Data.Versions,

    -- * Versions
    commitVersion,
    isCommitVersion,
    parseVersion,

    -- * Package manifests
    PkgManifest (..),
    newPkgManifest,
    pkgRevDeps,
    pkgDir,
    addRequiredToManifest,
    removeRequiredFromManifest,
    prettyPkgManifest,
    Comment,
    Commented (..),
    Required (..),
    futharkPkg,

    -- * Parsing package manifests
    parsePkgManifest,
    parsePkgManifestFromFile,
    errorBundlePretty,

    -- * Build list
    BuildList (..),
    prettyBuildList,
  )
where

import Control.Applicative
import Control.Monad
import Data.Either
import Data.Foldable
import Data.List (sortOn)
import Data.List.NonEmpty qualified as NE
import Data.Map qualified as M
import Data.Maybe
import Data.Text qualified as T
import Data.Text.IO qualified as T
import Data.Traversable
import Data.Versions (Chunk (Alphanum), Release (Release), SemVer (..), prettySemVer)
import Data.Void
import System.FilePath
import System.FilePath.Posix qualified as Posix
import Text.Megaparsec hiding (many, some)
import Text.Megaparsec.Char
import Prelude

-- | A package path is a unique identifier for a package, for example
-- @github.com/user/foo@.
type PkgPath = T.Text

-- | Turn a package path (which always uses forward slashes) into a
-- file path in the local file system (which might use different
-- slashes).
pkgPathFilePath :: PkgPath -> FilePath
pkgPathFilePath :: Text -> FilePath
pkgPathFilePath = [FilePath] -> FilePath
joinPath ([FilePath] -> FilePath)
-> (Text -> [FilePath]) -> Text -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> [FilePath]
Posix.splitPath (FilePath -> [FilePath])
-> (Text -> FilePath) -> Text -> [FilePath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> FilePath
T.unpack

-- | Versions of the form (0,0,0)-timestamp+hash are treated
-- specially, as a reference to the commit identified uniquely with
-- @hash@ (typically the Git commit ID).  This function detects such
-- versions.
isCommitVersion :: SemVer -> Maybe T.Text
isCommitVersion :: SemVer -> Maybe Text
isCommitVersion (SemVer Word
0 Word
0 Word
0 (Just (Release (Chunk
_ NE.:| []))) (Just Text
s)) = Text -> Maybe Text
forall a. a -> Maybe a
Just Text
s
isCommitVersion SemVer
_ = Maybe Text
forall a. Maybe a
Nothing

-- | @commitVersion timestamp commit@ constructs a commit version.
commitVersion :: T.Text -> T.Text -> SemVer
commitVersion :: Text -> Text -> SemVer
commitVersion Text
time Text
commit =
  Word -> Word -> Word -> Maybe Release -> Maybe Text -> SemVer
SemVer Word
0 Word
0 Word
0 (Release -> Maybe Release
forall a. a -> Maybe a
Just (Release -> Maybe Release) -> Release -> Maybe Release
forall a b. (a -> b) -> a -> b
$ NonEmpty Chunk -> Release
Release (NonEmpty Chunk -> Release) -> NonEmpty Chunk -> Release
forall a b. (a -> b) -> a -> b
$ Chunk -> NonEmpty Chunk
forall a. a -> NonEmpty a
NE.singleton (Chunk -> NonEmpty Chunk) -> Chunk -> NonEmpty Chunk
forall a b. (a -> b) -> a -> b
$ Text -> Chunk
Alphanum Text
time) (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
commit)

-- | Unfortunately, Data.Versions has a buggy semver parser that
-- collapses consecutive zeroes in the metadata field.  So, we define
-- our own parser here.  It's a little simpler too, since we don't
-- need full semver.
parseVersion :: T.Text -> Either (ParseErrorBundle T.Text Void) SemVer
parseVersion :: Text -> Either (ParseErrorBundle Text Void) SemVer
parseVersion = Parsec Void Text SemVer
-> FilePath -> Text -> Either (ParseErrorBundle Text Void) SemVer
forall e s a.
Parsec e s a -> FilePath -> s -> Either (ParseErrorBundle s e) a
parse (Parsec Void Text SemVer
semver' Parsec Void Text SemVer
-> ParsecT Void Text Identity () -> Parsec Void Text SemVer
forall a b.
ParsecT Void Text Identity a
-> ParsecT Void Text Identity b -> ParsecT Void Text Identity a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT Void Text Identity ()
forall e s (m :: * -> *). MonadParsec e s m => m ()
eof) FilePath
"Semantic Version"

semver' :: Parsec Void T.Text SemVer
semver' :: Parsec Void Text SemVer
semver' = Word -> Word -> Word -> Maybe Release -> Maybe Text -> SemVer
SemVer (Word -> Word -> Word -> Maybe Release -> Maybe Text -> SemVer)
-> ParsecT Void Text Identity Word
-> ParsecT
     Void
     Text
     Identity
     (Word -> Word -> Maybe Release -> Maybe Text -> SemVer)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void Text Identity Word
majorP ParsecT
  Void
  Text
  Identity
  (Word -> Word -> Maybe Release -> Maybe Text -> SemVer)
-> ParsecT Void Text Identity Word
-> ParsecT
     Void Text Identity (Word -> Maybe Release -> Maybe Text -> SemVer)
forall a b.
ParsecT Void Text Identity (a -> b)
-> ParsecT Void Text Identity a -> ParsecT Void Text Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT Void Text Identity Word
minorP ParsecT
  Void Text Identity (Word -> Maybe Release -> Maybe Text -> SemVer)
-> ParsecT Void Text Identity Word
-> ParsecT
     Void Text Identity (Maybe Release -> Maybe Text -> SemVer)
forall a b.
ParsecT Void Text Identity (a -> b)
-> ParsecT Void Text Identity a -> ParsecT Void Text Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT Void Text Identity Word
patchP ParsecT Void Text Identity (Maybe Release -> Maybe Text -> SemVer)
-> ParsecT Void Text Identity (Maybe Release)
-> ParsecT Void Text Identity (Maybe Text -> SemVer)
forall a b.
ParsecT Void Text Identity (a -> b)
-> ParsecT Void Text Identity a -> ParsecT Void Text Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT Void Text Identity (Maybe Release)
preRel ParsecT Void Text Identity (Maybe Text -> SemVer)
-> ParsecT Void Text Identity (Maybe Text)
-> Parsec Void Text SemVer
forall a b.
ParsecT Void Text Identity (a -> b)
-> ParsecT Void Text Identity a -> ParsecT Void Text Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT Void Text Identity (Maybe Text)
metaData
  where
    majorP :: ParsecT Void Text Identity Word
majorP = ParsecT Void Text Identity Word
digitsP ParsecT Void Text Identity Word
-> ParsecT Void Text Identity Char
-> ParsecT Void Text Identity Word
forall a b.
ParsecT Void Text Identity a
-> ParsecT Void Text Identity b -> ParsecT Void Text Identity a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Token Text -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'.'
    minorP :: ParsecT Void Text Identity Word
minorP = ParsecT Void Text Identity Word
majorP
    patchP :: ParsecT Void Text Identity Word
patchP = ParsecT Void Text Identity Word
digitsP
    digitsP :: ParsecT Void Text Identity Word
digitsP = FilePath -> Word
forall a. Read a => FilePath -> a
read (FilePath -> Word)
-> ParsecT Void Text Identity FilePath
-> ParsecT Void Text Identity Word
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((Text -> FilePath
T.unpack (Text -> FilePath)
-> ParsecT Void Text Identity Text
-> ParsecT Void Text Identity FilePath
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Text
Tokens Text
"0") ParsecT Void Text Identity FilePath
-> ParsecT Void Text Identity FilePath
-> ParsecT Void Text Identity FilePath
forall a.
ParsecT Void Text Identity a
-> ParsecT Void Text Identity a -> ParsecT Void Text Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT Void Text Identity Char
-> ParsecT Void Text Identity FilePath
forall a.
ParsecT Void Text Identity a -> ParsecT Void Text Identity [a]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
some ParsecT Void Text Identity Char
ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
digitChar)
    preRel :: ParsecT Void Text Identity (Maybe Release)
preRel = (Chunk -> Release) -> Maybe Chunk -> Maybe Release
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (NonEmpty Chunk -> Release
Release (NonEmpty Chunk -> Release)
-> (Chunk -> NonEmpty Chunk) -> Chunk -> Release
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Chunk -> NonEmpty Chunk
forall a. a -> NonEmpty a
NE.singleton) (Maybe Chunk -> Maybe Release)
-> ParsecT Void Text Identity (Maybe Chunk)
-> ParsecT Void Text Identity (Maybe Release)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void Text Identity Chunk
-> ParsecT Void Text Identity (Maybe Chunk)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional ParsecT Void Text Identity Chunk
preRel'
    preRel' :: ParsecT Void Text Identity Chunk
preRel' = Token Text -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'-' ParsecT Void Text Identity Char
-> ParsecT Void Text Identity Chunk
-> ParsecT Void Text Identity Chunk
forall a b.
ParsecT Void Text Identity a
-> ParsecT Void Text Identity b -> ParsecT Void Text Identity b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Text -> Chunk
Alphanum (Text -> Chunk) -> (FilePath -> Text) -> FilePath -> Chunk
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> Text
T.pack (FilePath -> Chunk)
-> ParsecT Void Text Identity FilePath
-> ParsecT Void Text Identity Chunk
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void Text Identity Char
-> ParsecT Void Text Identity FilePath
forall a.
ParsecT Void Text Identity a -> ParsecT Void Text Identity [a]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
some ParsecT Void Text Identity Char
ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
digitChar)
    metaData :: ParsecT Void Text Identity (Maybe Text)
metaData = ParsecT Void Text Identity Text
-> ParsecT Void Text Identity (Maybe Text)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional ParsecT Void Text Identity Text
metaData'
    metaData' :: ParsecT Void Text Identity Text
metaData' = Token Text -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'+' ParsecT Void Text Identity Char
-> ParsecT Void Text Identity Text
-> ParsecT Void Text Identity Text
forall a b.
ParsecT Void Text Identity a
-> ParsecT Void Text Identity b -> ParsecT Void Text Identity b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (FilePath -> Text
T.pack (FilePath -> Text)
-> ParsecT Void Text Identity FilePath
-> ParsecT Void Text Identity Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void Text Identity Char
-> ParsecT Void Text Identity FilePath
forall a.
ParsecT Void Text Identity a -> ParsecT Void Text Identity [a]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
some ParsecT Void Text Identity Char
ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
alphaNumChar)

-- | The dependencies of a (revision of a) package is a mapping from
-- package paths to minimum versions (and an optional hash pinning).
newtype PkgRevDeps = PkgRevDeps (M.Map PkgPath (SemVer, Maybe T.Text))
  deriving (Int -> PkgRevDeps -> ShowS
[PkgRevDeps] -> ShowS
PkgRevDeps -> FilePath
(Int -> PkgRevDeps -> ShowS)
-> (PkgRevDeps -> FilePath)
-> ([PkgRevDeps] -> ShowS)
-> Show PkgRevDeps
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PkgRevDeps -> ShowS
showsPrec :: Int -> PkgRevDeps -> ShowS
$cshow :: PkgRevDeps -> FilePath
show :: PkgRevDeps -> FilePath
$cshowList :: [PkgRevDeps] -> ShowS
showList :: [PkgRevDeps] -> ShowS
Show)

instance Semigroup PkgRevDeps where
  PkgRevDeps Map Text (SemVer, Maybe Text)
x <> :: PkgRevDeps -> PkgRevDeps -> PkgRevDeps
<> PkgRevDeps Map Text (SemVer, Maybe Text)
y = Map Text (SemVer, Maybe Text) -> PkgRevDeps
PkgRevDeps (Map Text (SemVer, Maybe Text) -> PkgRevDeps)
-> Map Text (SemVer, Maybe Text) -> PkgRevDeps
forall a b. (a -> b) -> a -> b
$ Map Text (SemVer, Maybe Text)
x Map Text (SemVer, Maybe Text)
-> Map Text (SemVer, Maybe Text) -> Map Text (SemVer, Maybe Text)
forall a. Semigroup a => a -> a -> a
<> Map Text (SemVer, Maybe Text)
y

instance Monoid PkgRevDeps where
  mempty :: PkgRevDeps
mempty = Map Text (SemVer, Maybe Text) -> PkgRevDeps
PkgRevDeps Map Text (SemVer, Maybe Text)
forall a. Monoid a => a
mempty

--- Package manifest

-- | A line comment.
type Comment = T.Text

-- | Wraps a value with an annotation of preceding line comments.
-- This is important to our goal of being able to programmatically
-- modify the @futhark.pkg@ file while keeping comments intact.
data Commented a = Commented
  { forall a. Commented a -> [Text]
comments :: [Comment],
    forall a. Commented a -> a
commented :: a
  }
  deriving (Int -> Commented a -> ShowS
[Commented a] -> ShowS
Commented a -> FilePath
(Int -> Commented a -> ShowS)
-> (Commented a -> FilePath)
-> ([Commented a] -> ShowS)
-> Show (Commented a)
forall a. Show a => Int -> Commented a -> ShowS
forall a. Show a => [Commented a] -> ShowS
forall a. Show a => Commented a -> FilePath
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. Show a => Int -> Commented a -> ShowS
showsPrec :: Int -> Commented a -> ShowS
$cshow :: forall a. Show a => Commented a -> FilePath
show :: Commented a -> FilePath
$cshowList :: forall a. Show a => [Commented a] -> ShowS
showList :: [Commented a] -> ShowS
Show, Commented a -> Commented a -> Bool
(Commented a -> Commented a -> Bool)
-> (Commented a -> Commented a -> Bool) -> Eq (Commented a)
forall a. Eq a => Commented a -> Commented a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall a. Eq a => Commented a -> Commented a -> Bool
== :: Commented a -> Commented a -> Bool
$c/= :: forall a. Eq a => Commented a -> Commented a -> Bool
/= :: Commented a -> Commented a -> Bool
Eq)

instance Functor Commented where
  fmap :: forall a b. (a -> b) -> Commented a -> Commented b
fmap = (a -> b) -> Commented a -> Commented b
forall (t :: * -> *) a b. Traversable t => (a -> b) -> t a -> t b
fmapDefault

instance Foldable Commented where
  foldMap :: forall m a. Monoid m => (a -> m) -> Commented a -> m
foldMap = (a -> m) -> Commented a -> m
forall (t :: * -> *) m a.
(Traversable t, Monoid m) =>
(a -> m) -> t a -> m
foldMapDefault

instance Traversable Commented where
  traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Commented a -> f (Commented b)
traverse a -> f b
f (Commented [Text]
cs a
x) = [Text] -> b -> Commented b
forall a. [Text] -> a -> Commented a
Commented [Text]
cs (b -> Commented b) -> f b -> f (Commented b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> f b
f a
x

-- | An entry in the @required@ section of a @futhark.pkg@ file.
data Required = Required
  { -- | Name of the required package.
    Required -> Text
requiredPkg :: PkgPath,
    -- | The minimum revision.
    Required -> SemVer
requiredPkgRev :: SemVer,
    -- | An optional hash indicating what
    -- this revision looked like the last
    -- time we saw it.  Used for integrity
    -- checking.
    Required -> Maybe Text
requiredHash :: Maybe T.Text
  }
  deriving (Int -> Required -> ShowS
[Required] -> ShowS
Required -> FilePath
(Int -> Required -> ShowS)
-> (Required -> FilePath) -> ([Required] -> ShowS) -> Show Required
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Required -> ShowS
showsPrec :: Int -> Required -> ShowS
$cshow :: Required -> FilePath
show :: Required -> FilePath
$cshowList :: [Required] -> ShowS
showList :: [Required] -> ShowS
Show, Required -> Required -> Bool
(Required -> Required -> Bool)
-> (Required -> Required -> Bool) -> Eq Required
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Required -> Required -> Bool
== :: Required -> Required -> Bool
$c/= :: Required -> Required -> Bool
/= :: Required -> Required -> Bool
Eq)

-- | The name of the file containing the futhark-pkg manifest.
futharkPkg :: FilePath
futharkPkg :: FilePath
futharkPkg = FilePath
"futhark.pkg"

-- | A structure corresponding to a @futhark.pkg@ file, including
-- comments.  It is an invariant that duplicate required packages do
-- not occcur (the parser will verify this).
data PkgManifest = PkgManifest
  { -- | The name of the package.
    PkgManifest -> Commented (Maybe Text)
manifestPkgPath :: Commented (Maybe PkgPath),
    PkgManifest -> Commented [Either Text Required]
manifestRequire :: Commented [Either Comment Required],
    PkgManifest -> [Text]
manifestEndComments :: [Comment]
  }
  deriving (Int -> PkgManifest -> ShowS
[PkgManifest] -> ShowS
PkgManifest -> FilePath
(Int -> PkgManifest -> ShowS)
-> (PkgManifest -> FilePath)
-> ([PkgManifest] -> ShowS)
-> Show PkgManifest
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PkgManifest -> ShowS
showsPrec :: Int -> PkgManifest -> ShowS
$cshow :: PkgManifest -> FilePath
show :: PkgManifest -> FilePath
$cshowList :: [PkgManifest] -> ShowS
showList :: [PkgManifest] -> ShowS
Show, PkgManifest -> PkgManifest -> Bool
(PkgManifest -> PkgManifest -> Bool)
-> (PkgManifest -> PkgManifest -> Bool) -> Eq PkgManifest
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PkgManifest -> PkgManifest -> Bool
== :: PkgManifest -> PkgManifest -> Bool
$c/= :: PkgManifest -> PkgManifest -> Bool
/= :: PkgManifest -> PkgManifest -> Bool
Eq)

-- | Possibly given a package path, construct an otherwise-empty manifest file.
newPkgManifest :: Maybe PkgPath -> PkgManifest
newPkgManifest :: Maybe Text -> PkgManifest
newPkgManifest Maybe Text
p =
  Commented (Maybe Text)
-> Commented [Either Text Required] -> [Text] -> PkgManifest
PkgManifest ([Text] -> Maybe Text -> Commented (Maybe Text)
forall a. [Text] -> a -> Commented a
Commented [Text]
forall a. Monoid a => a
mempty Maybe Text
p) ([Text]
-> [Either Text Required] -> Commented [Either Text Required]
forall a. [Text] -> a -> Commented a
Commented [Text]
forall a. Monoid a => a
mempty [Either Text Required]
forall a. Monoid a => a
mempty) [Text]
forall a. Monoid a => a
mempty

-- | Prettyprint a package manifest such that it can be written to a
-- @futhark.pkg@ file.
prettyPkgManifest :: PkgManifest -> T.Text
prettyPkgManifest :: PkgManifest -> Text
prettyPkgManifest (PkgManifest Commented (Maybe Text)
name Commented [Either Text Required]
required [Text]
endcs) =
  [Text] -> Text
T.unlines ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$
    [[Text]] -> [Text]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
      [ Commented (Maybe Text) -> [Text]
forall a. Commented a -> [Text]
prettyComments Commented (Maybe Text)
name,
        [Text] -> (Text -> [Text]) -> Maybe Text -> [Text]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (Text -> [Text]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> [Text]) -> (Text -> Text) -> Text -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text
"package " <>) (Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\n")) (Maybe Text -> [Text]) -> Maybe Text -> [Text]
forall a b. (a -> b) -> a -> b
$ Commented (Maybe Text) -> Maybe Text
forall a. Commented a -> a
commented Commented (Maybe Text)
name,
        Commented [Either Text Required] -> [Text]
forall a. Commented a -> [Text]
prettyComments Commented [Either Text Required]
required,
        [Text
"require {"],
        (Either Text Required -> Text) -> [Either Text Required] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map ((Text
"  " <>) (Text -> Text)
-> (Either Text Required -> Text) -> Either Text Required -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Either Text Required -> Text
prettyRequired) ([Either Text Required] -> [Text])
-> [Either Text Required] -> [Text]
forall a b. (a -> b) -> a -> b
$ Commented [Either Text Required] -> [Either Text Required]
forall a. Commented a -> a
commented Commented [Either Text Required]
required,
        [Text
"}"],
        (Text -> Text) -> [Text] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map Text -> Text
prettyComment [Text]
endcs
      ]
  where
    prettyComments :: Commented a -> [Text]
prettyComments = (Text -> Text) -> [Text] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map Text -> Text
prettyComment ([Text] -> [Text])
-> (Commented a -> [Text]) -> Commented a -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Commented a -> [Text]
forall a. Commented a -> [Text]
comments
    prettyComment :: Text -> Text
prettyComment = (Text
"--" <>)
    prettyRequired :: Either Text Required -> Text
prettyRequired (Left Text
c) = Text -> Text
prettyComment Text
c
    prettyRequired (Right (Required Text
p SemVer
r Maybe Text
h)) =
      [Text] -> Text
T.unwords ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$
        [Maybe Text] -> [Text]
forall a. [Maybe a] -> [a]
catMaybes
          [ Text -> Maybe Text
forall a. a -> Maybe a
Just Text
p,
            Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$ SemVer -> Text
prettySemVer SemVer
r,
            (Text
"#" <>) (Text -> Text) -> Maybe Text -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Text
h
          ]

-- | The required packages listed in a package manifest.
pkgRevDeps :: PkgManifest -> PkgRevDeps
pkgRevDeps :: PkgManifest -> PkgRevDeps
pkgRevDeps =
  Map Text (SemVer, Maybe Text) -> PkgRevDeps
PkgRevDeps
    (Map Text (SemVer, Maybe Text) -> PkgRevDeps)
-> (PkgManifest -> Map Text (SemVer, Maybe Text))
-> PkgManifest
-> PkgRevDeps
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Text, (SemVer, Maybe Text))] -> Map Text (SemVer, Maybe Text)
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList
    ([(Text, (SemVer, Maybe Text))] -> Map Text (SemVer, Maybe Text))
-> (PkgManifest -> [(Text, (SemVer, Maybe Text))])
-> PkgManifest
-> Map Text (SemVer, Maybe Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Either Text Required -> Maybe (Text, (SemVer, Maybe Text)))
-> [Either Text Required] -> [(Text, (SemVer, Maybe Text))]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe Either Text Required -> Maybe (Text, (SemVer, Maybe Text))
forall {a}. Either a Required -> Maybe (Text, (SemVer, Maybe Text))
onR
    ([Either Text Required] -> [(Text, (SemVer, Maybe Text))])
-> (PkgManifest -> [Either Text Required])
-> PkgManifest
-> [(Text, (SemVer, Maybe Text))]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Commented [Either Text Required] -> [Either Text Required]
forall a. Commented a -> a
commented
    (Commented [Either Text Required] -> [Either Text Required])
-> (PkgManifest -> Commented [Either Text Required])
-> PkgManifest
-> [Either Text Required]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PkgManifest -> Commented [Either Text Required]
manifestRequire
  where
    onR :: Either a Required -> Maybe (Text, (SemVer, Maybe Text))
onR (Right Required
r) = (Text, (SemVer, Maybe Text)) -> Maybe (Text, (SemVer, Maybe Text))
forall a. a -> Maybe a
Just (Required -> Text
requiredPkg Required
r, (Required -> SemVer
requiredPkgRev Required
r, Required -> Maybe Text
requiredHash Required
r))
    onR (Left a
_) = Maybe (Text, (SemVer, Maybe Text))
forall a. Maybe a
Nothing

-- | Where in the corresponding repository archive we can expect to
-- find the package files.
pkgDir :: PkgManifest -> Maybe Posix.FilePath
pkgDir :: PkgManifest -> Maybe FilePath
pkgDir =
  (Text -> FilePath) -> Maybe Text -> Maybe FilePath
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
    ( ShowS
Posix.addTrailingPathSeparator
        ShowS -> (Text -> FilePath) -> Text -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FilePath
"lib" Posix.</>)
        ShowS -> (Text -> FilePath) -> Text -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> FilePath
T.unpack
    )
    (Maybe Text -> Maybe FilePath)
-> (PkgManifest -> Maybe Text) -> PkgManifest -> Maybe FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Commented (Maybe Text) -> Maybe Text
forall a. Commented a -> a
commented
    (Commented (Maybe Text) -> Maybe Text)
-> (PkgManifest -> Commented (Maybe Text))
-> PkgManifest
-> Maybe Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PkgManifest -> Commented (Maybe Text)
manifestPkgPath

-- | Add new required package to the package manifest.  If the package
-- was already present, return the old version.
addRequiredToManifest :: Required -> PkgManifest -> (PkgManifest, Maybe Required)
addRequiredToManifest :: Required -> PkgManifest -> (PkgManifest, Maybe Required)
addRequiredToManifest Required
new_r PkgManifest
pm =
  let (Maybe Required
old, [Either Text Required]
requires') = (Maybe Required
 -> Either Text Required -> (Maybe Required, Either Text Required))
-> Maybe Required
-> [Either Text Required]
-> (Maybe Required, [Either Text Required])
forall (t :: * -> *) s a b.
Traversable t =>
(s -> a -> (s, b)) -> s -> t a -> (s, t b)
mapAccumL Maybe Required
-> Either Text Required -> (Maybe Required, Either Text Required)
forall {a}.
Maybe Required
-> Either a Required -> (Maybe Required, Either a Required)
add Maybe Required
forall a. Maybe a
Nothing ([Either Text Required]
 -> (Maybe Required, [Either Text Required]))
-> [Either Text Required]
-> (Maybe Required, [Either Text Required])
forall a b. (a -> b) -> a -> b
$ Commented [Either Text Required] -> [Either Text Required]
forall a. Commented a -> a
commented (Commented [Either Text Required] -> [Either Text Required])
-> Commented [Either Text Required] -> [Either Text Required]
forall a b. (a -> b) -> a -> b
$ PkgManifest -> Commented [Either Text Required]
manifestRequire PkgManifest
pm
   in ( if Maybe Required -> Bool
forall a. Maybe a -> Bool
isJust Maybe Required
old
          then PkgManifest
pm {manifestRequire :: Commented [Either Text Required]
manifestRequire = [Either Text Required]
requires' [Either Text Required]
-> Commented [Either Text Required]
-> Commented [Either Text Required]
forall a b. a -> Commented b -> Commented a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ PkgManifest -> Commented [Either Text Required]
manifestRequire PkgManifest
pm}
          else PkgManifest
pm {manifestRequire :: Commented [Either Text Required]
manifestRequire = ([Either Text Required]
-> [Either Text Required] -> [Either Text Required]
forall a. [a] -> [a] -> [a]
++ [Required -> Either Text Required
forall a b. b -> Either a b
Right Required
new_r]) ([Either Text Required] -> [Either Text Required])
-> Commented [Either Text Required]
-> Commented [Either Text Required]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> PkgManifest -> Commented [Either Text Required]
manifestRequire PkgManifest
pm},
        Maybe Required
old
      )
  where
    add :: Maybe Required
-> Either a Required -> (Maybe Required, Either a Required)
add Maybe Required
acc (Left a
c) = (Maybe Required
acc, a -> Either a Required
forall a b. a -> Either a b
Left a
c)
    add Maybe Required
acc (Right Required
r)
      | Required -> Text
requiredPkg Required
r Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Required -> Text
requiredPkg Required
new_r = (Required -> Maybe Required
forall a. a -> Maybe a
Just Required
r, Required -> Either a Required
forall a b. b -> Either a b
Right Required
new_r)
      | Bool
otherwise = (Maybe Required
acc, Required -> Either a Required
forall a b. b -> Either a b
Right Required
r)

-- | Check if the manifest specifies a required package with the given
-- package path.
requiredInManifest :: PkgPath -> PkgManifest -> Maybe Required
requiredInManifest :: Text -> PkgManifest -> Maybe Required
requiredInManifest Text
p =
  (Required -> Bool) -> [Required] -> Maybe Required
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find ((Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
p) (Text -> Bool) -> (Required -> Text) -> Required -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Required -> Text
requiredPkg) ([Required] -> Maybe Required)
-> (PkgManifest -> [Required]) -> PkgManifest -> Maybe Required
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Either Text Required] -> [Required]
forall a b. [Either a b] -> [b]
rights ([Either Text Required] -> [Required])
-> (PkgManifest -> [Either Text Required])
-> PkgManifest
-> [Required]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Commented [Either Text Required] -> [Either Text Required]
forall a. Commented a -> a
commented (Commented [Either Text Required] -> [Either Text Required])
-> (PkgManifest -> Commented [Either Text Required])
-> PkgManifest
-> [Either Text Required]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PkgManifest -> Commented [Either Text Required]
manifestRequire

-- | Remove a required package from the manifest.  Returns 'Nothing'
-- if the package was not found in the manifest, and otherwise the new
-- manifest and the 'Required' that was present.
removeRequiredFromManifest :: PkgPath -> PkgManifest -> Maybe (PkgManifest, Required)
removeRequiredFromManifest :: Text -> PkgManifest -> Maybe (PkgManifest, Required)
removeRequiredFromManifest Text
p PkgManifest
pm = do
  Required
r <- Text -> PkgManifest -> Maybe Required
requiredInManifest Text
p PkgManifest
pm
  (PkgManifest, Required) -> Maybe (PkgManifest, Required)
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
    ( PkgManifest
pm {manifestRequire :: Commented [Either Text Required]
manifestRequire = (Either Text Required -> Bool)
-> [Either Text Required] -> [Either Text Required]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool)
-> (Either Text Required -> Bool) -> Either Text Required -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Either Text Required -> Bool
forall {a}. Either a Required -> Bool
matches) ([Either Text Required] -> [Either Text Required])
-> Commented [Either Text Required]
-> Commented [Either Text Required]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> PkgManifest -> Commented [Either Text Required]
manifestRequire PkgManifest
pm},
      Required
r
    )
  where
    matches :: Either a Required -> Bool
matches = (a -> Bool) -> (Required -> Bool) -> Either a Required -> Bool
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Bool -> a -> Bool
forall a b. a -> b -> a
const Bool
False) ((Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
p) (Text -> Bool) -> (Required -> Text) -> Required -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Required -> Text
requiredPkg)

--- Parsing futhark.pkg.

type Parser = Parsec Void T.Text

pPkgManifest :: Parser PkgManifest
pPkgManifest :: Parser PkgManifest
pPkgManifest = do
  [Text]
c1 <- Parser [Text]
pComments
  Maybe Text
p <- ParsecT Void Text Identity Text
-> ParsecT Void Text Identity (Maybe Text)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (ParsecT Void Text Identity Text
 -> ParsecT Void Text Identity (Maybe Text))
-> ParsecT Void Text Identity Text
-> ParsecT Void Text Identity (Maybe Text)
forall a b. (a -> b) -> a -> b
$ Text -> ParsecT Void Text Identity ()
lexstr Text
"package" ParsecT Void Text Identity ()
-> ParsecT Void Text Identity Text
-> ParsecT Void Text Identity Text
forall a b.
ParsecT Void Text Identity a
-> ParsecT Void Text Identity b -> ParsecT Void Text Identity b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT Void Text Identity Text
pPkgPath
  ParsecT Void Text Identity ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
space
  [Text]
c2 <- Parser [Text]
pComments
  [Either Text Required]
required <-
    ( Text -> ParsecT Void Text Identity ()
lexstr Text
"require"
        ParsecT Void Text Identity ()
-> ParsecT Void Text Identity [Either Text Required]
-> ParsecT Void Text Identity [Either Text Required]
forall a b.
ParsecT Void Text Identity a
-> ParsecT Void Text Identity b -> ParsecT Void Text Identity b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT Void Text Identity [Either Text Required]
-> ParsecT Void Text Identity [Either Text Required]
forall a. Parser a -> Parser a
braces (ParsecT Void Text Identity (Either Text Required)
-> ParsecT Void Text Identity [Either Text Required]
forall a.
ParsecT Void Text Identity a -> ParsecT Void Text Identity [a]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many (ParsecT Void Text Identity (Either Text Required)
 -> ParsecT Void Text Identity [Either Text Required])
-> ParsecT Void Text Identity (Either Text Required)
-> ParsecT Void Text Identity [Either Text Required]
forall a b. (a -> b) -> a -> b
$ (Text -> Either Text Required
forall a b. a -> Either a b
Left (Text -> Either Text Required)
-> ParsecT Void Text Identity Text
-> ParsecT Void Text Identity (Either Text Required)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void Text Identity Text
pComment) ParsecT Void Text Identity (Either Text Required)
-> ParsecT Void Text Identity (Either Text Required)
-> ParsecT Void Text Identity (Either Text Required)
forall a.
ParsecT Void Text Identity a
-> ParsecT Void Text Identity a -> ParsecT Void Text Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Required -> Either Text Required
forall a b. b -> Either a b
Right (Required -> Either Text Required)
-> ParsecT Void Text Identity Required
-> ParsecT Void Text Identity (Either Text Required)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void Text Identity Required
pRequired))
      )
      ParsecT Void Text Identity [Either Text Required]
-> ParsecT Void Text Identity [Either Text Required]
-> ParsecT Void Text Identity [Either Text Required]
forall a.
ParsecT Void Text Identity a
-> ParsecT Void Text Identity a -> ParsecT Void Text Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> [Either Text Required]
-> ParsecT Void Text Identity [Either Text Required]
forall a. a -> ParsecT Void Text Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
  [Text]
c3 <- Parser [Text]
pComments
  ParsecT Void Text Identity ()
forall e s (m :: * -> *). MonadParsec e s m => m ()
eof
  PkgManifest -> Parser PkgManifest
forall a. a -> ParsecT Void Text Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PkgManifest -> Parser PkgManifest)
-> PkgManifest -> Parser PkgManifest
forall a b. (a -> b) -> a -> b
$ Commented (Maybe Text)
-> Commented [Either Text Required] -> [Text] -> PkgManifest
PkgManifest ([Text] -> Maybe Text -> Commented (Maybe Text)
forall a. [Text] -> a -> Commented a
Commented [Text]
c1 Maybe Text
p) ([Text]
-> [Either Text Required] -> Commented [Either Text Required]
forall a. [Text] -> a -> Commented a
Commented [Text]
c2 [Either Text Required]
required) [Text]
c3
  where
    lexeme :: Parser a -> Parser a
    lexeme :: forall a. Parser a -> Parser a
lexeme Parser a
p = Parser a
p Parser a -> ParsecT Void Text Identity () -> Parser a
forall a b.
ParsecT Void Text Identity a
-> ParsecT Void Text Identity b -> ParsecT Void Text Identity a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT Void Text Identity ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
space

    lexeme' :: ParsecT Void Text Identity a -> ParsecT Void Text Identity a
lexeme' ParsecT Void Text Identity a
p = ParsecT Void Text Identity a
p ParsecT Void Text Identity a
-> ParsecT Void Text Identity [Token Text]
-> ParsecT Void Text Identity a
forall a b.
ParsecT Void Text Identity a
-> ParsecT Void Text Identity b -> ParsecT Void Text Identity a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT Void Text Identity [Token Text]
spaceNoEol

    lexstr :: T.Text -> Parser ()
    lexstr :: Text -> ParsecT Void Text Identity ()
lexstr = ParsecT Void Text Identity Text -> ParsecT Void Text Identity ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ParsecT Void Text Identity Text -> ParsecT Void Text Identity ())
-> (Text -> ParsecT Void Text Identity Text)
-> Text
-> ParsecT Void Text Identity ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParsecT Void Text Identity Text -> ParsecT Void Text Identity Text
forall a. Parser a -> Parser a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (ParsecT Void Text Identity Text
 -> ParsecT Void Text Identity Text)
-> (Text -> ParsecT Void Text Identity Text)
-> Text
-> ParsecT Void Text Identity Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParsecT Void Text Identity Text -> ParsecT Void Text Identity Text
forall a. Parser a -> Parser a
lexeme (ParsecT Void Text Identity Text
 -> ParsecT Void Text Identity Text)
-> (Text -> ParsecT Void Text Identity Text)
-> Text
-> ParsecT Void Text Identity Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ParsecT Void Text Identity Text
Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string

    braces :: Parser a -> Parser a
    braces :: forall a. Parser a -> Parser a
braces Parser a
p = Text -> ParsecT Void Text Identity ()
lexstr Text
"{" ParsecT Void Text Identity () -> Parser a -> Parser a
forall a b.
ParsecT Void Text Identity a
-> ParsecT Void Text Identity b -> ParsecT Void Text Identity b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser a
p Parser a -> ParsecT Void Text Identity () -> Parser a
forall a b.
ParsecT Void Text Identity a
-> ParsecT Void Text Identity b -> ParsecT Void Text Identity a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Text -> ParsecT Void Text Identity ()
lexstr Text
"}"

    spaceNoEol :: ParsecT Void Text Identity [Token Text]
spaceNoEol = ParsecT Void Text Identity (Token Text)
-> ParsecT Void Text Identity [Token Text]
forall a.
ParsecT Void Text Identity a -> ParsecT Void Text Identity [a]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many (ParsecT Void Text Identity (Token Text)
 -> ParsecT Void Text Identity [Token Text])
-> ParsecT Void Text Identity (Token Text)
-> ParsecT Void Text Identity [Token Text]
forall a b. (a -> b) -> a -> b
$ [Token Text] -> ParsecT Void Text Identity (Token Text)
forall (f :: * -> *) e s (m :: * -> *).
(Foldable f, MonadParsec e s m) =>
f (Token s) -> m (Token s)
oneOf (FilePath
" \t" :: String)

    pPkgPath :: ParsecT Void Text Identity Text
pPkgPath =
      FilePath -> Text
T.pack
        (FilePath -> Text)
-> ParsecT Void Text Identity FilePath
-> ParsecT Void Text Identity Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void Text Identity Char
-> ParsecT Void Text Identity FilePath
forall a.
ParsecT Void Text Identity a -> ParsecT Void Text Identity [a]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
some (ParsecT Void Text Identity Char
ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
alphaNumChar ParsecT Void Text Identity Char
-> ParsecT Void Text Identity Char
-> ParsecT Void Text Identity Char
forall a.
ParsecT Void Text Identity a
-> ParsecT Void Text Identity a -> ParsecT Void Text Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> [Token Text] -> ParsecT Void Text Identity (Token Text)
forall (f :: * -> *) e s (m :: * -> *).
(Foldable f, MonadParsec e s m) =>
f (Token s) -> m (Token s)
oneOf (FilePath
"@-/.:" :: String))
        ParsecT Void Text Identity Text
-> FilePath -> ParsecT Void Text Identity Text
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> FilePath -> m a
<?> FilePath
"package path"

    pRequired :: ParsecT Void Text Identity Required
pRequired =
      ParsecT Void Text Identity ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
space
        ParsecT Void Text Identity ()
-> ParsecT Void Text Identity Required
-> ParsecT Void Text Identity Required
forall a b.
ParsecT Void Text Identity a
-> ParsecT Void Text Identity b -> ParsecT Void Text Identity b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ( Text -> SemVer -> Maybe Text -> Required
Required
               (Text -> SemVer -> Maybe Text -> Required)
-> ParsecT Void Text Identity Text
-> ParsecT Void Text Identity (SemVer -> Maybe Text -> Required)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void Text Identity Text -> ParsecT Void Text Identity Text
forall a. Parser a -> Parser a
lexeme' ParsecT Void Text Identity Text
pPkgPath
               ParsecT Void Text Identity (SemVer -> Maybe Text -> Required)
-> Parsec Void Text SemVer
-> ParsecT Void Text Identity (Maybe Text -> Required)
forall a b.
ParsecT Void Text Identity (a -> b)
-> ParsecT Void Text Identity a -> ParsecT Void Text Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parsec Void Text SemVer -> Parsec Void Text SemVer
forall a. Parser a -> Parser a
lexeme' Parsec Void Text SemVer
semver'
               ParsecT Void Text Identity (Maybe Text -> Required)
-> ParsecT Void Text Identity (Maybe Text)
-> ParsecT Void Text Identity Required
forall a b.
ParsecT Void Text Identity (a -> b)
-> ParsecT Void Text Identity a -> ParsecT Void Text Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT Void Text Identity Text
-> ParsecT Void Text Identity (Maybe Text)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (ParsecT Void Text Identity Text -> ParsecT Void Text Identity Text
forall a. Parser a -> Parser a
lexeme' ParsecT Void Text Identity Text
pHash)
           )
        ParsecT Void Text Identity Required
-> ParsecT Void Text Identity ()
-> ParsecT Void Text Identity Required
forall a b.
ParsecT Void Text Identity a
-> ParsecT Void Text Identity b -> ParsecT Void Text Identity a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT Void Text Identity ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
space
        ParsecT Void Text Identity Required
-> FilePath -> ParsecT Void Text Identity Required
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> FilePath -> m a
<?> FilePath
"package requirement"

    pHash :: ParsecT Void Text Identity Text
pHash = Token Text -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'#' ParsecT Void Text Identity Char
-> ParsecT Void Text Identity Text
-> ParsecT Void Text Identity Text
forall a b.
ParsecT Void Text Identity a
-> ParsecT Void Text Identity b -> ParsecT Void Text Identity b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (FilePath -> Text
T.pack (FilePath -> Text)
-> ParsecT Void Text Identity FilePath
-> ParsecT Void Text Identity Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void Text Identity Char
-> ParsecT Void Text Identity FilePath
forall a.
ParsecT Void Text Identity a -> ParsecT Void Text Identity [a]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
some ParsecT Void Text Identity Char
ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
alphaNumChar)

    pComment :: ParsecT Void Text Identity Text
pComment = ParsecT Void Text Identity Text -> ParsecT Void Text Identity Text
forall a. Parser a -> Parser a
lexeme (ParsecT Void Text Identity Text
 -> ParsecT Void Text Identity Text)
-> ParsecT Void Text Identity Text
-> ParsecT Void Text Identity Text
forall a b. (a -> b) -> a -> b
$ FilePath -> Text
T.pack (FilePath -> Text)
-> ParsecT Void Text Identity FilePath
-> ParsecT Void Text Identity Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"--" ParsecT Void Text Identity (Tokens Text)
-> ParsecT Void Text Identity FilePath
-> ParsecT Void Text Identity FilePath
forall a b.
ParsecT Void Text Identity a
-> ParsecT Void Text Identity b -> ParsecT Void Text Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT Void Text Identity Char
ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *). MonadParsec e s m => m (Token s)
anySingle ParsecT Void Text Identity Char
-> ParsecT Void Text Identity ()
-> ParsecT Void Text Identity FilePath
forall (m :: * -> *) a end. MonadPlus m => m a -> m end -> m [a]
`manyTill` (ParsecT Void Text Identity (Tokens Text)
-> ParsecT Void Text Identity ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Tokens s)
eol ParsecT Void Text Identity ()
-> ParsecT Void Text Identity () -> ParsecT Void Text Identity ()
forall a.
ParsecT Void Text Identity a
-> ParsecT Void Text Identity a -> ParsecT Void Text Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT Void Text Identity ()
forall e s (m :: * -> *). MonadParsec e s m => m ()
eof))

    pComments :: Parser [Comment]
    pComments :: Parser [Text]
pComments = [Maybe Text] -> [Text]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe Text] -> [Text])
-> ParsecT Void Text Identity [Maybe Text] -> Parser [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void Text Identity (Maybe Text)
-> ParsecT Void Text Identity [Maybe Text]
forall a.
ParsecT Void Text Identity a -> ParsecT Void Text Identity [a]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many (ParsecT Void Text Identity (Maybe Text)
comment ParsecT Void Text Identity (Maybe Text)
-> ParsecT Void Text Identity (Maybe Text)
-> ParsecT Void Text Identity (Maybe Text)
forall a.
ParsecT Void Text Identity a
-> ParsecT Void Text Identity a -> ParsecT Void Text Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT Void Text Identity (Maybe Text)
forall {a}. ParsecT Void Text Identity (Maybe a)
blankLine)
      where
        comment :: ParsecT Void Text Identity (Maybe Text)
comment = Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text)
-> ParsecT Void Text Identity Text
-> ParsecT Void Text Identity (Maybe Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void Text Identity Text
pComment
        blankLine :: ParsecT Void Text Identity (Maybe a)
blankLine = ParsecT Void Text Identity Char
-> ParsecT Void Text Identity FilePath
forall a.
ParsecT Void Text Identity a -> ParsecT Void Text Identity [a]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
some ParsecT Void Text Identity Char
ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
spaceChar ParsecT Void Text Identity FilePath
-> ParsecT Void Text Identity (Maybe a)
-> ParsecT Void Text Identity (Maybe a)
forall a b.
ParsecT Void Text Identity a
-> ParsecT Void Text Identity b -> ParsecT Void Text Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Maybe a -> ParsecT Void Text Identity (Maybe a)
forall a. a -> ParsecT Void Text Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe a
forall a. Maybe a
Nothing

-- | Parse a pretty as a 'PkgManifest'.  The 'FilePath' is used for any error messages.
parsePkgManifest :: FilePath -> T.Text -> Either (ParseErrorBundle T.Text Void) PkgManifest
parsePkgManifest :: FilePath -> Text -> Either (ParseErrorBundle Text Void) PkgManifest
parsePkgManifest = Parser PkgManifest
-> FilePath
-> Text
-> Either (ParseErrorBundle Text Void) PkgManifest
forall e s a.
Parsec e s a -> FilePath -> s -> Either (ParseErrorBundle s e) a
parse Parser PkgManifest
pPkgManifest

-- | Read contents of file and pass it to 'parsePkgManifest'.
parsePkgManifestFromFile :: FilePath -> IO PkgManifest
parsePkgManifestFromFile :: FilePath -> IO PkgManifest
parsePkgManifestFromFile FilePath
f = do
  Text
s <- FilePath -> IO Text
T.readFile FilePath
f
  case FilePath -> Text -> Either (ParseErrorBundle Text Void) PkgManifest
parsePkgManifest FilePath
f Text
s of
    Left ParseErrorBundle Text Void
err -> FilePath -> IO PkgManifest
forall a. FilePath -> IO a
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail (FilePath -> IO PkgManifest) -> FilePath -> IO PkgManifest
forall a b. (a -> b) -> a -> b
$ ParseErrorBundle Text Void -> FilePath
forall s e.
(VisualStream s, TraversableStream s, ShowErrorComponent e) =>
ParseErrorBundle s e -> FilePath
errorBundlePretty ParseErrorBundle Text Void
err
    Right PkgManifest
m -> PkgManifest -> IO PkgManifest
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure PkgManifest
m

-- | A mapping from package paths to their chosen revisions.  This is
-- the result of the version solver.
newtype BuildList = BuildList {BuildList -> Map Text SemVer
unBuildList :: M.Map PkgPath SemVer}
  deriving (BuildList -> BuildList -> Bool
(BuildList -> BuildList -> Bool)
-> (BuildList -> BuildList -> Bool) -> Eq BuildList
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: BuildList -> BuildList -> Bool
== :: BuildList -> BuildList -> Bool
$c/= :: BuildList -> BuildList -> Bool
/= :: BuildList -> BuildList -> Bool
Eq, Int -> BuildList -> ShowS
[BuildList] -> ShowS
BuildList -> FilePath
(Int -> BuildList -> ShowS)
-> (BuildList -> FilePath)
-> ([BuildList] -> ShowS)
-> Show BuildList
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> BuildList -> ShowS
showsPrec :: Int -> BuildList -> ShowS
$cshow :: BuildList -> FilePath
show :: BuildList -> FilePath
$cshowList :: [BuildList] -> ShowS
showList :: [BuildList] -> ShowS
Show)

-- | Prettyprint a build list; one package per line and
-- newline-terminated.
prettyBuildList :: BuildList -> T.Text
prettyBuildList :: BuildList -> Text
prettyBuildList (BuildList Map Text SemVer
m) = [Text] -> Text
T.unlines ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ ((Text, SemVer) -> Text) -> [(Text, SemVer)] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (Text, SemVer) -> Text
f ([(Text, SemVer)] -> [Text]) -> [(Text, SemVer)] -> [Text]
forall a b. (a -> b) -> a -> b
$ ((Text, SemVer) -> Text) -> [(Text, SemVer)] -> [(Text, SemVer)]
forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn (Text, SemVer) -> Text
forall a b. (a, b) -> a
fst ([(Text, SemVer)] -> [(Text, SemVer)])
-> [(Text, SemVer)] -> [(Text, SemVer)]
forall a b. (a -> b) -> a -> b
$ Map Text SemVer -> [(Text, SemVer)]
forall k a. Map k a -> [(k, a)]
M.toList Map Text SemVer
m
  where
    f :: (Text, SemVer) -> Text
f (Text
p, SemVer
v) = [Text] -> Text
T.unwords [Text
p, Text
"=>", SemVer -> Text
prettySemVer SemVer
v]