-- | 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 (SemVer (..), VUnit (..), 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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> [FilePath]
Posix.splitPath 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 [VChunk
_] (Just Text
s)) = forall a. a -> Maybe a
Just Text
s
isCommitVersion SemVer
_ = 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 -> [VChunk] -> Maybe Text -> SemVer
SemVer Word
0 Word
0 Word
0 [forall a. a -> NonEmpty a
NE.singleton (Text -> VUnit
Str Text
time)] (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 = forall e s a.
Parsec e s a -> FilePath -> s -> Either (ParseErrorBundle s e) a
parse (ParsecT Void Text Identity SemVer
semver' forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall e s (m :: * -> *). MonadParsec e s m => m ()
eof) FilePath
"Semantic Version"

semver' :: Parsec Void T.Text SemVer
semver' :: ParsecT Void Text Identity SemVer
semver' = Word -> Word -> Word -> [VChunk] -> Maybe Text -> SemVer
SemVer forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void Text Identity Word
majorP forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT Void Text Identity Word
minorP forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT Void Text Identity Word
patchP forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT Void Text Identity [VChunk]
preRel 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 forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
'.'
    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 = forall a. Read a => FilePath -> a
read forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((Text -> FilePath
T.unpack forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"0") forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall (f :: * -> *) a. Alternative f => f a -> f [a]
some forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
digitChar)
    preRel :: ParsecT Void Text Identity [VChunk]
preRel = forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] forall (f :: * -> *) a. Applicative f => a -> f a
pure forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional ParsecT Void Text Identity VChunk
preRel'
    preRel' :: ParsecT Void Text Identity VChunk
preRel' = forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
'-' forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> VUnit
Str forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> Text
T.pack forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (f :: * -> *) a. Alternative f => f a -> f [a]
some forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
digitChar)
    metaData :: ParsecT Void Text Identity (Maybe Text)
metaData = forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional ParsecT Void Text Identity Text
metaData'
    metaData' :: ParsecT Void Text Identity Text
metaData' = forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
'+' forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (FilePath -> Text
T.pack forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (f :: * -> *) a. Alternative f => f a -> f [a]
some 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
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [PkgRevDeps] -> ShowS
$cshowList :: [PkgRevDeps] -> ShowS
show :: PkgRevDeps -> FilePath
$cshow :: PkgRevDeps -> FilePath
showsPrec :: Int -> PkgRevDeps -> ShowS
$cshowsPrec :: Int -> 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 forall a b. (a -> b) -> a -> b
$ Map Text (SemVer, Maybe Text)
x 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 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
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
showList :: [Commented a] -> ShowS
$cshowList :: forall a. Show a => [Commented a] -> ShowS
show :: Commented a -> FilePath
$cshow :: forall a. Show a => Commented a -> FilePath
showsPrec :: Int -> Commented a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> Commented a -> ShowS
Show, Commented a -> Commented a -> Bool
forall a. Eq a => Commented a -> Commented a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Commented a -> Commented a -> Bool
$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
Eq)

instance Functor Commented where
  fmap :: forall a b. (a -> b) -> Commented a -> Commented b
fmap = 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 = 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) = forall a. [Text] -> a -> Commented a
Commented [Text]
cs 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
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [Required] -> ShowS
$cshowList :: [Required] -> ShowS
show :: Required -> FilePath
$cshow :: Required -> FilePath
showsPrec :: Int -> Required -> ShowS
$cshowsPrec :: Int -> Required -> ShowS
Show, Required -> Required -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Required -> Required -> Bool
$c/= :: Required -> Required -> Bool
== :: Required -> Required -> Bool
$c== :: 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
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [PkgManifest] -> ShowS
$cshowList :: [PkgManifest] -> ShowS
show :: PkgManifest -> FilePath
$cshow :: PkgManifest -> FilePath
showsPrec :: Int -> PkgManifest -> ShowS
$cshowsPrec :: Int -> PkgManifest -> ShowS
Show, PkgManifest -> PkgManifest -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PkgManifest -> PkgManifest -> Bool
$c/= :: PkgManifest -> PkgManifest -> Bool
== :: PkgManifest -> PkgManifest -> Bool
$c== :: 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 (forall a. [Text] -> a -> Commented a
Commented forall a. Monoid a => a
mempty Maybe Text
p) (forall a. [Text] -> a -> Commented a
Commented forall a. Monoid a => a
mempty forall a. Monoid a => a
mempty) 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 forall a b. (a -> b) -> a -> b
$
    forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
      [ forall a. Commented a -> [Text]
prettyComments Commented (Maybe Text)
name,
        forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text
"package " <>) forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. Semigroup a => a -> a -> a
<> Text
"\n")) forall a b. (a -> b) -> a -> b
$ forall a. Commented a -> a
commented Commented (Maybe Text)
name,
        forall a. Commented a -> [Text]
prettyComments Commented [Either Text Required]
required,
        [Text
"require {"],
        forall a b. (a -> b) -> [a] -> [b]
map ((Text
"  " <>) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Either Text Required -> Text
prettyRequired) forall a b. (a -> b) -> a -> b
$ forall a. Commented a -> a
commented Commented [Either Text Required]
required,
        [Text
"}"],
        forall a b. (a -> b) -> [a] -> [b]
map Text -> Text
prettyComment [Text]
endcs
      ]
  where
    prettyComments :: Commented a -> [Text]
prettyComments = forall a b. (a -> b) -> [a] -> [b]
map Text -> Text
prettyComment forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 forall a b. (a -> b) -> a -> b
$
        forall a. [Maybe a] -> [a]
catMaybes
          [ forall a. a -> Maybe a
Just Text
p,
            forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ SemVer -> Text
prettySemVer SemVer
r,
            (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
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k a. Ord k => [(k, a)] -> Map k a
M.fromList
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe forall {a}. Either a Required -> Maybe (Text, (SemVer, Maybe Text))
onR
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Commented a -> a
commented
    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) = 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
_) = 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 =
  forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
    ( ShowS
Posix.addTrailingPathSeparator
        forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FilePath
"lib" Posix.</>)
        forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> FilePath
T.unpack
    )
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Commented a -> a
commented
    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') = forall (t :: * -> *) s a b.
Traversable t =>
(s -> a -> (s, b)) -> s -> t a -> (s, t b)
mapAccumL forall {a}.
Maybe Required
-> Either a Required -> (Maybe Required, Either a Required)
add forall a. Maybe a
Nothing forall a b. (a -> b) -> a -> b
$ forall a. Commented a -> a
commented forall a b. (a -> b) -> a -> b
$ PkgManifest -> Commented [Either Text Required]
manifestRequire PkgManifest
pm
   in ( if forall a. Maybe a -> Bool
isJust Maybe Required
old
          then PkgManifest
pm {manifestRequire :: Commented [Either Text Required]
manifestRequire = [Either Text Required]
requires' 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 = (forall a. [a] -> [a] -> [a]
++ [forall a b. b -> Either a b
Right Required
new_r]) 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, forall a b. a -> Either a b
Left a
c)
    add Maybe Required
acc (Right Required
r)
      | Required -> Text
requiredPkg Required
r forall a. Eq a => a -> a -> Bool
== Required -> Text
requiredPkg Required
new_r = (forall a. a -> Maybe a
Just Required
r, forall a b. b -> Either a b
Right Required
new_r)
      | Bool
otherwise = (Maybe Required
acc, 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 =
  forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find ((forall a. Eq a => a -> a -> Bool
== Text
p) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Required -> Text
requiredPkg) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. [Either a b] -> [b]
rights forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Commented a -> a
commented 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
  forall (f :: * -> *) a. Applicative f => a -> f a
pure
    ( PkgManifest
pm {manifestRequire :: Commented [Either Text Required]
manifestRequire = forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {a}. Either a Required -> Bool
matches) 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 = forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall a b. a -> b -> a
const Bool
False) ((forall a. Eq a => a -> a -> Bool
== Text
p) 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 <- forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional forall a b. (a -> b) -> a -> b
$ Text -> Parser ()
lexstr Text
"package" forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT Void Text Identity Text
pPkgPath
  forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
space
  [Text]
c2 <- Parser [Text]
pComments
  [Either Text Required]
required <-
    ( Text -> Parser ()
lexstr Text
"require"
        forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall a. Parser a -> Parser a
braces (forall (f :: * -> *) a. Alternative f => f a -> f [a]
many forall a b. (a -> b) -> a -> b
$ (forall a b. a -> Either a b
Left forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void Text Identity Text
pComment) forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (forall a b. b -> Either a b
Right forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void Text Identity Required
pRequired))
      )
      forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall (f :: * -> *) a. Applicative f => a -> f a
pure []
  [Text]
c3 <- Parser [Text]
pComments
  forall e s (m :: * -> *). MonadParsec e s m => m ()
eof
  forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Commented (Maybe Text)
-> Commented [Either Text Required] -> [Text] -> PkgManifest
PkgManifest (forall a. [Text] -> a -> Commented a
Commented [Text]
c1 Maybe Text
p) (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 forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* 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 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 -> Parser ()
lexstr = forall (f :: * -> *) a. Functor f => f a -> f ()
void forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Parser a -> Parser a
lexeme forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 -> Parser ()
lexstr Text
"{" forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser a
p forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Text -> Parser ()
lexstr Text
"}"

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

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

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

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

    pComments :: Parser [Comment]
    pComments :: Parser [Text]
pComments = forall a. [Maybe a] -> [a]
catMaybes forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (f :: * -> *) a. Alternative f => f a -> f [a]
many (ParsecT Void Text Identity (Maybe Text)
comment forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall {a}. ParsecT Void Text Identity (Maybe a)
blankLine)
      where
        comment :: ParsecT Void Text Identity (Maybe Text)
comment = forall a. a -> Maybe a
Just 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 = forall (f :: * -> *) a. Alternative f => f a -> f [a]
some forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
spaceChar forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (f :: * -> *) a. Applicative f => a -> f a
pure 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 = 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 -> forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail forall a b. (a -> b) -> a -> b
$ forall s e.
(VisualStream s, TraversableStream s, ShowErrorComponent e) =>
ParseErrorBundle s e -> FilePath
errorBundlePretty ParseErrorBundle Text Void
err
    Right PkgManifest
m -> 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
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BuildList -> BuildList -> Bool
$c/= :: BuildList -> BuildList -> Bool
== :: BuildList -> BuildList -> Bool
$c== :: BuildList -> BuildList -> Bool
Eq, Int -> BuildList -> ShowS
[BuildList] -> ShowS
BuildList -> FilePath
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [BuildList] -> ShowS
$cshowList :: [BuildList] -> ShowS
show :: BuildList -> FilePath
$cshow :: BuildList -> FilePath
showsPrec :: Int -> BuildList -> ShowS
$cshowsPrec :: Int -> 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 forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (Text, SemVer) -> Text
f forall a b. (a -> b) -> a -> b
$ forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn forall a b. (a, b) -> a
fst forall a b. (a -> b) -> a -> b
$ 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]