{-# LANGUAGE OverloadedStrings #-}

-- | 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 qualified Data.List.NonEmpty as NE
import qualified Data.Map as M
import Data.Maybe
import qualified Data.Text as T
import qualified Data.Text.IO as T
import Data.Traversable
import Data.Versions (SemVer (..), VUnit (..), prettySemVer)
import Data.Void
import System.FilePath
import qualified System.FilePath.Posix 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 :: PkgPath -> FilePath
pkgPathFilePath = [FilePath] -> FilePath
joinPath ([FilePath] -> FilePath)
-> (PkgPath -> [FilePath]) -> PkgPath -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> [FilePath]
Posix.splitPath (FilePath -> [FilePath])
-> (PkgPath -> FilePath) -> PkgPath -> [FilePath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PkgPath -> 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 PkgPath
isCommitVersion (SemVer Word
0 Word
0 Word
0 [VChunk
_] [Str PkgPath
s NE.:| []]) = PkgPath -> Maybe PkgPath
forall a. a -> Maybe a
Just PkgPath
s
isCommitVersion SemVer
_ = Maybe PkgPath
forall a. Maybe a
Nothing

-- | @commitVersion timestamp commit@ constructs a commit version.
commitVersion :: T.Text -> T.Text -> SemVer
commitVersion :: PkgPath -> PkgPath -> SemVer
commitVersion PkgPath
time PkgPath
commit =
  Word -> Word -> Word -> [VChunk] -> [VChunk] -> SemVer
SemVer Word
0 Word
0 Word
0 [PkgPath -> VUnit
Str PkgPath
time VUnit -> [VUnit] -> VChunk
forall a. a -> [a] -> NonEmpty a
NE.:| []] [PkgPath -> VUnit
Str PkgPath
commit VUnit -> [VUnit] -> VChunk
forall a. a -> [a] -> NonEmpty a
NE.:| []]

-- | 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 :: PkgPath -> Either (ParseErrorBundle PkgPath Void) SemVer
parseVersion = Parsec Void PkgPath SemVer
-> FilePath
-> PkgPath
-> Either (ParseErrorBundle PkgPath Void) SemVer
forall e s a.
Parsec e s a -> FilePath -> s -> Either (ParseErrorBundle s e) a
parse (Parsec Void PkgPath SemVer
semver' Parsec Void PkgPath SemVer
-> ParsecT Void PkgPath Identity () -> Parsec Void PkgPath SemVer
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT Void PkgPath Identity ()
forall e s (m :: * -> *). MonadParsec e s m => m ()
eof) FilePath
"Semantic Version"

semver' :: Parsec Void T.Text SemVer
semver' :: Parsec Void PkgPath SemVer
semver' = Word -> Word -> Word -> [VChunk] -> [VChunk] -> SemVer
SemVer (Word -> Word -> Word -> [VChunk] -> [VChunk] -> SemVer)
-> ParsecT Void PkgPath Identity Word
-> ParsecT
     Void
     PkgPath
     Identity
     (Word -> Word -> [VChunk] -> [VChunk] -> SemVer)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void PkgPath Identity Word
majorP ParsecT
  Void
  PkgPath
  Identity
  (Word -> Word -> [VChunk] -> [VChunk] -> SemVer)
-> ParsecT Void PkgPath Identity Word
-> ParsecT
     Void PkgPath Identity (Word -> [VChunk] -> [VChunk] -> SemVer)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT Void PkgPath Identity Word
minorP ParsecT
  Void PkgPath Identity (Word -> [VChunk] -> [VChunk] -> SemVer)
-> ParsecT Void PkgPath Identity Word
-> ParsecT Void PkgPath Identity ([VChunk] -> [VChunk] -> SemVer)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT Void PkgPath Identity Word
patchP ParsecT Void PkgPath Identity ([VChunk] -> [VChunk] -> SemVer)
-> ParsecT Void PkgPath Identity [VChunk]
-> ParsecT Void PkgPath Identity ([VChunk] -> SemVer)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT Void PkgPath Identity [VChunk]
preRel ParsecT Void PkgPath Identity ([VChunk] -> SemVer)
-> ParsecT Void PkgPath Identity [VChunk]
-> Parsec Void PkgPath SemVer
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT Void PkgPath Identity [VChunk]
metaData
  where
    majorP :: ParsecT Void PkgPath Identity Word
majorP = ParsecT Void PkgPath Identity Word
digitsP ParsecT Void PkgPath Identity Word
-> ParsecT Void PkgPath Identity Char
-> ParsecT Void PkgPath Identity Word
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Token PkgPath -> ParsecT Void PkgPath Identity (Token PkgPath)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token PkgPath
'.'
    minorP :: ParsecT Void PkgPath Identity Word
minorP = ParsecT Void PkgPath Identity Word
majorP
    patchP :: ParsecT Void PkgPath Identity Word
patchP = ParsecT Void PkgPath Identity Word
digitsP
    digitsP :: ParsecT Void PkgPath Identity Word
digitsP = FilePath -> Word
forall a. Read a => FilePath -> a
read (FilePath -> Word)
-> ParsecT Void PkgPath Identity FilePath
-> ParsecT Void PkgPath Identity Word
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((PkgPath -> FilePath
T.unpack (PkgPath -> FilePath)
-> ParsecT Void PkgPath Identity PkgPath
-> ParsecT Void PkgPath Identity FilePath
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Tokens PkgPath -> ParsecT Void PkgPath Identity (Tokens PkgPath)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens PkgPath
"0") ParsecT Void PkgPath Identity FilePath
-> ParsecT Void PkgPath Identity FilePath
-> ParsecT Void PkgPath Identity FilePath
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT Void PkgPath Identity Char
-> ParsecT Void PkgPath Identity FilePath
forall (f :: * -> *) a. Alternative f => f a -> f [a]
some ParsecT Void PkgPath Identity Char
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
digitChar)
    preRel :: ParsecT Void PkgPath Identity [VChunk]
preRel = [VChunk] -> (VChunk -> [VChunk]) -> Maybe VChunk -> [VChunk]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] VChunk -> [VChunk]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe VChunk -> [VChunk])
-> ParsecT Void PkgPath Identity (Maybe VChunk)
-> ParsecT Void PkgPath Identity [VChunk]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void PkgPath Identity VChunk
-> ParsecT Void PkgPath Identity (Maybe VChunk)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional ParsecT Void PkgPath Identity VChunk
preRel'
    preRel' :: ParsecT Void PkgPath Identity VChunk
preRel' = Token PkgPath -> ParsecT Void PkgPath Identity (Token PkgPath)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token PkgPath
'-' ParsecT Void PkgPath Identity Char
-> ParsecT Void PkgPath Identity VChunk
-> ParsecT Void PkgPath Identity VChunk
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (VUnit -> VChunk
forall (f :: * -> *) a. Applicative f => a -> f a
pure (VUnit -> VChunk) -> (FilePath -> VUnit) -> FilePath -> VChunk
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PkgPath -> VUnit
Str (PkgPath -> VUnit) -> (FilePath -> PkgPath) -> FilePath -> VUnit
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> PkgPath
T.pack (FilePath -> VChunk)
-> ParsecT Void PkgPath Identity FilePath
-> ParsecT Void PkgPath Identity VChunk
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void PkgPath Identity Char
-> ParsecT Void PkgPath Identity FilePath
forall (f :: * -> *) a. Alternative f => f a -> f [a]
some ParsecT Void PkgPath Identity Char
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
digitChar)
    metaData :: ParsecT Void PkgPath Identity [VChunk]
metaData = [VChunk] -> (VChunk -> [VChunk]) -> Maybe VChunk -> [VChunk]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] VChunk -> [VChunk]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe VChunk -> [VChunk])
-> ParsecT Void PkgPath Identity (Maybe VChunk)
-> ParsecT Void PkgPath Identity [VChunk]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void PkgPath Identity VChunk
-> ParsecT Void PkgPath Identity (Maybe VChunk)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional ParsecT Void PkgPath Identity VChunk
metaData'
    metaData' :: ParsecT Void PkgPath Identity VChunk
metaData' = Token PkgPath -> ParsecT Void PkgPath Identity (Token PkgPath)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token PkgPath
'+' ParsecT Void PkgPath Identity Char
-> ParsecT Void PkgPath Identity VChunk
-> ParsecT Void PkgPath Identity VChunk
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (VUnit -> VChunk
forall (f :: * -> *) a. Applicative f => a -> f a
pure (VUnit -> VChunk) -> (FilePath -> VUnit) -> FilePath -> VChunk
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PkgPath -> VUnit
Str (PkgPath -> VUnit) -> (FilePath -> PkgPath) -> FilePath -> VUnit
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> PkgPath
T.pack (FilePath -> VChunk)
-> ParsecT Void PkgPath Identity FilePath
-> ParsecT Void PkgPath Identity VChunk
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void PkgPath Identity Char
-> ParsecT Void PkgPath Identity FilePath
forall (f :: * -> *) a. Alternative f => f a -> f [a]
some ParsecT Void PkgPath Identity Char
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
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 PkgPath (SemVer, Maybe PkgPath)
x <> :: PkgRevDeps -> PkgRevDeps -> PkgRevDeps
<> PkgRevDeps Map PkgPath (SemVer, Maybe PkgPath)
y = Map PkgPath (SemVer, Maybe PkgPath) -> PkgRevDeps
PkgRevDeps (Map PkgPath (SemVer, Maybe PkgPath) -> PkgRevDeps)
-> Map PkgPath (SemVer, Maybe PkgPath) -> PkgRevDeps
forall a b. (a -> b) -> a -> b
$ Map PkgPath (SemVer, Maybe PkgPath)
x Map PkgPath (SemVer, Maybe PkgPath)
-> Map PkgPath (SemVer, Maybe PkgPath)
-> Map PkgPath (SemVer, Maybe PkgPath)
forall a. Semigroup a => a -> a -> a
<> Map PkgPath (SemVer, Maybe PkgPath)
y

instance Monoid PkgRevDeps where
  mempty :: PkgRevDeps
mempty = Map PkgPath (SemVer, Maybe PkgPath) -> PkgRevDeps
PkgRevDeps Map PkgPath (SemVer, Maybe PkgPath)
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 -> [PkgPath]
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
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
(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
/= :: 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 = (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 [PkgPath]
cs a
x) = [PkgPath] -> b -> Commented b
forall a. [PkgPath] -> a -> Commented a
Commented [PkgPath]
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 -> PkgPath
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 PkgPath
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
showList :: [Required] -> ShowS
$cshowList :: [Required] -> ShowS
show :: Required -> FilePath
$cshow :: Required -> FilePath
showsPrec :: Int -> Required -> ShowS
$cshowsPrec :: Int -> Required -> ShowS
Show, Required -> Required -> Bool
(Required -> Required -> Bool)
-> (Required -> Required -> Bool) -> Eq Required
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 PkgPath)
manifestPkgPath :: Commented (Maybe PkgPath),
    PkgManifest -> Commented [Either PkgPath Required]
manifestRequire :: Commented [Either Comment Required],
    PkgManifest -> [PkgPath]
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
showList :: [PkgManifest] -> ShowS
$cshowList :: [PkgManifest] -> ShowS
show :: PkgManifest -> FilePath
$cshow :: PkgManifest -> FilePath
showsPrec :: Int -> PkgManifest -> ShowS
$cshowsPrec :: Int -> PkgManifest -> ShowS
Show, PkgManifest -> PkgManifest -> Bool
(PkgManifest -> PkgManifest -> Bool)
-> (PkgManifest -> PkgManifest -> Bool) -> Eq PkgManifest
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 PkgPath -> PkgManifest
newPkgManifest Maybe PkgPath
p =
  Commented (Maybe PkgPath)
-> Commented [Either PkgPath Required] -> [PkgPath] -> PkgManifest
PkgManifest ([PkgPath] -> Maybe PkgPath -> Commented (Maybe PkgPath)
forall a. [PkgPath] -> a -> Commented a
Commented [PkgPath]
forall a. Monoid a => a
mempty Maybe PkgPath
p) ([PkgPath]
-> [Either PkgPath Required] -> Commented [Either PkgPath Required]
forall a. [PkgPath] -> a -> Commented a
Commented [PkgPath]
forall a. Monoid a => a
mempty [Either PkgPath Required]
forall a. Monoid a => a
mempty) [PkgPath]
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 -> PkgPath
prettyPkgManifest (PkgManifest Commented (Maybe PkgPath)
name Commented [Either PkgPath Required]
required [PkgPath]
endcs) =
  [PkgPath] -> PkgPath
T.unlines ([PkgPath] -> PkgPath) -> [PkgPath] -> PkgPath
forall a b. (a -> b) -> a -> b
$
    [[PkgPath]] -> [PkgPath]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
      [ Commented (Maybe PkgPath) -> [PkgPath]
forall a. Commented a -> [PkgPath]
prettyComments Commented (Maybe PkgPath)
name,
        [PkgPath] -> (PkgPath -> [PkgPath]) -> Maybe PkgPath -> [PkgPath]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (PkgPath -> [PkgPath]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PkgPath -> [PkgPath])
-> (PkgPath -> PkgPath) -> PkgPath -> [PkgPath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PkgPath
"package " PkgPath -> PkgPath -> PkgPath
forall a. Semigroup a => a -> a -> a
<>) (PkgPath -> PkgPath) -> (PkgPath -> PkgPath) -> PkgPath -> PkgPath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PkgPath -> PkgPath -> PkgPath
forall a. Semigroup a => a -> a -> a
<> PkgPath
"\n")) (Maybe PkgPath -> [PkgPath]) -> Maybe PkgPath -> [PkgPath]
forall a b. (a -> b) -> a -> b
$ Commented (Maybe PkgPath) -> Maybe PkgPath
forall a. Commented a -> a
commented Commented (Maybe PkgPath)
name,
        Commented [Either PkgPath Required] -> [PkgPath]
forall a. Commented a -> [PkgPath]
prettyComments Commented [Either PkgPath Required]
required,
        [PkgPath
"require {"],
        (Either PkgPath Required -> PkgPath)
-> [Either PkgPath Required] -> [PkgPath]
forall a b. (a -> b) -> [a] -> [b]
map ((PkgPath
"  " PkgPath -> PkgPath -> PkgPath
forall a. Semigroup a => a -> a -> a
<>) (PkgPath -> PkgPath)
-> (Either PkgPath Required -> PkgPath)
-> Either PkgPath Required
-> PkgPath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Either PkgPath Required -> PkgPath
prettyRequired) ([Either PkgPath Required] -> [PkgPath])
-> [Either PkgPath Required] -> [PkgPath]
forall a b. (a -> b) -> a -> b
$ Commented [Either PkgPath Required] -> [Either PkgPath Required]
forall a. Commented a -> a
commented Commented [Either PkgPath Required]
required,
        [PkgPath
"}"],
        (PkgPath -> PkgPath) -> [PkgPath] -> [PkgPath]
forall a b. (a -> b) -> [a] -> [b]
map PkgPath -> PkgPath
prettyComment [PkgPath]
endcs
      ]
  where
    prettyComments :: Commented a -> [PkgPath]
prettyComments = (PkgPath -> PkgPath) -> [PkgPath] -> [PkgPath]
forall a b. (a -> b) -> [a] -> [b]
map PkgPath -> PkgPath
prettyComment ([PkgPath] -> [PkgPath])
-> (Commented a -> [PkgPath]) -> Commented a -> [PkgPath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Commented a -> [PkgPath]
forall a. Commented a -> [PkgPath]
comments
    prettyComment :: PkgPath -> PkgPath
prettyComment = (PkgPath
"--" PkgPath -> PkgPath -> PkgPath
forall a. Semigroup a => a -> a -> a
<>)
    prettyRequired :: Either PkgPath Required -> PkgPath
prettyRequired (Left PkgPath
c) = PkgPath -> PkgPath
prettyComment PkgPath
c
    prettyRequired (Right (Required PkgPath
p SemVer
r Maybe PkgPath
h)) =
      [PkgPath] -> PkgPath
T.unwords ([PkgPath] -> PkgPath) -> [PkgPath] -> PkgPath
forall a b. (a -> b) -> a -> b
$
        [Maybe PkgPath] -> [PkgPath]
forall a. [Maybe a] -> [a]
catMaybes
          [ PkgPath -> Maybe PkgPath
forall a. a -> Maybe a
Just PkgPath
p,
            PkgPath -> Maybe PkgPath
forall a. a -> Maybe a
Just (PkgPath -> Maybe PkgPath) -> PkgPath -> Maybe PkgPath
forall a b. (a -> b) -> a -> b
$ SemVer -> PkgPath
prettySemVer SemVer
r,
            (PkgPath
"#" PkgPath -> PkgPath -> PkgPath
forall a. Semigroup a => a -> a -> a
<>) (PkgPath -> PkgPath) -> Maybe PkgPath -> Maybe PkgPath
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe PkgPath
h
          ]

-- | The required packages listed in a package manifest.
pkgRevDeps :: PkgManifest -> PkgRevDeps
pkgRevDeps :: PkgManifest -> PkgRevDeps
pkgRevDeps =
  Map PkgPath (SemVer, Maybe PkgPath) -> PkgRevDeps
PkgRevDeps (Map PkgPath (SemVer, Maybe PkgPath) -> PkgRevDeps)
-> (PkgManifest -> Map PkgPath (SemVer, Maybe PkgPath))
-> PkgManifest
-> PkgRevDeps
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(PkgPath, (SemVer, Maybe PkgPath))]
-> Map PkgPath (SemVer, Maybe PkgPath)
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ([(PkgPath, (SemVer, Maybe PkgPath))]
 -> Map PkgPath (SemVer, Maybe PkgPath))
-> (PkgManifest -> [(PkgPath, (SemVer, Maybe PkgPath))])
-> PkgManifest
-> Map PkgPath (SemVer, Maybe PkgPath)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Either PkgPath Required
 -> Maybe (PkgPath, (SemVer, Maybe PkgPath)))
-> [Either PkgPath Required]
-> [(PkgPath, (SemVer, Maybe PkgPath))]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe Either PkgPath Required -> Maybe (PkgPath, (SemVer, Maybe PkgPath))
forall {a}.
Either a Required -> Maybe (PkgPath, (SemVer, Maybe PkgPath))
onR
    ([Either PkgPath Required] -> [(PkgPath, (SemVer, Maybe PkgPath))])
-> (PkgManifest -> [Either PkgPath Required])
-> PkgManifest
-> [(PkgPath, (SemVer, Maybe PkgPath))]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Commented [Either PkgPath Required] -> [Either PkgPath Required]
forall a. Commented a -> a
commented
    (Commented [Either PkgPath Required] -> [Either PkgPath Required])
-> (PkgManifest -> Commented [Either PkgPath Required])
-> PkgManifest
-> [Either PkgPath Required]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PkgManifest -> Commented [Either PkgPath Required]
manifestRequire
  where
    onR :: Either a Required -> Maybe (PkgPath, (SemVer, Maybe PkgPath))
onR (Right Required
r) = (PkgPath, (SemVer, Maybe PkgPath))
-> Maybe (PkgPath, (SemVer, Maybe PkgPath))
forall a. a -> Maybe a
Just (Required -> PkgPath
requiredPkg Required
r, (Required -> SemVer
requiredPkgRev Required
r, Required -> Maybe PkgPath
requiredHash Required
r))
    onR (Left a
_) = Maybe (PkgPath, (SemVer, Maybe PkgPath))
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 =
  (PkgPath -> FilePath) -> Maybe PkgPath -> Maybe FilePath
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
    ( ShowS
Posix.addTrailingPathSeparator ShowS -> (PkgPath -> FilePath) -> PkgPath -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FilePath
"lib" FilePath -> ShowS
Posix.</>)
        ShowS -> (PkgPath -> FilePath) -> PkgPath -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PkgPath -> FilePath
T.unpack
    )
    (Maybe PkgPath -> Maybe FilePath)
-> (PkgManifest -> Maybe PkgPath) -> PkgManifest -> Maybe FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Commented (Maybe PkgPath) -> Maybe PkgPath
forall a. Commented a -> a
commented
    (Commented (Maybe PkgPath) -> Maybe PkgPath)
-> (PkgManifest -> Commented (Maybe PkgPath))
-> PkgManifest
-> Maybe PkgPath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PkgManifest -> Commented (Maybe PkgPath)
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 PkgPath Required]
requires') = (Maybe Required
 -> Either PkgPath Required
 -> (Maybe Required, Either PkgPath Required))
-> Maybe Required
-> [Either PkgPath Required]
-> (Maybe Required, [Either PkgPath Required])
forall (t :: * -> *) a b c.
Traversable t =>
(a -> b -> (a, c)) -> a -> t b -> (a, t c)
mapAccumL Maybe Required
-> Either PkgPath Required
-> (Maybe Required, Either PkgPath Required)
forall {a}.
Maybe Required
-> Either a Required -> (Maybe Required, Either a Required)
add Maybe Required
forall a. Maybe a
Nothing ([Either PkgPath Required]
 -> (Maybe Required, [Either PkgPath Required]))
-> [Either PkgPath Required]
-> (Maybe Required, [Either PkgPath Required])
forall a b. (a -> b) -> a -> b
$ Commented [Either PkgPath Required] -> [Either PkgPath Required]
forall a. Commented a -> a
commented (Commented [Either PkgPath Required] -> [Either PkgPath Required])
-> Commented [Either PkgPath Required] -> [Either PkgPath Required]
forall a b. (a -> b) -> a -> b
$ PkgManifest -> Commented [Either PkgPath Required]
manifestRequire PkgManifest
pm
   in ( if Maybe Required -> Bool
forall a. Maybe a -> Bool
isJust Maybe Required
old
          then PkgManifest
pm {manifestRequire :: Commented [Either PkgPath Required]
manifestRequire = [Either PkgPath Required]
requires' [Either PkgPath Required]
-> Commented [Either PkgPath Required]
-> Commented [Either PkgPath Required]
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ PkgManifest -> Commented [Either PkgPath Required]
manifestRequire PkgManifest
pm}
          else PkgManifest
pm {manifestRequire :: Commented [Either PkgPath Required]
manifestRequire = ([Either PkgPath Required]
-> [Either PkgPath Required] -> [Either PkgPath Required]
forall a. [a] -> [a] -> [a]
++ [Required -> Either PkgPath Required
forall a b. b -> Either a b
Right Required
new_r]) ([Either PkgPath Required] -> [Either PkgPath Required])
-> Commented [Either PkgPath Required]
-> Commented [Either PkgPath Required]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> PkgManifest -> Commented [Either PkgPath 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 -> PkgPath
requiredPkg Required
r PkgPath -> PkgPath -> Bool
forall a. Eq a => a -> a -> Bool
== Required -> PkgPath
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 :: PkgPath -> PkgManifest -> Maybe Required
requiredInManifest PkgPath
p =
  (Required -> Bool) -> [Required] -> Maybe Required
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find ((PkgPath -> PkgPath -> Bool
forall a. Eq a => a -> a -> Bool
== PkgPath
p) (PkgPath -> Bool) -> (Required -> PkgPath) -> Required -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Required -> PkgPath
requiredPkg) ([Required] -> Maybe Required)
-> (PkgManifest -> [Required]) -> PkgManifest -> Maybe Required
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Either PkgPath Required] -> [Required]
forall a b. [Either a b] -> [b]
rights ([Either PkgPath Required] -> [Required])
-> (PkgManifest -> [Either PkgPath Required])
-> PkgManifest
-> [Required]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Commented [Either PkgPath Required] -> [Either PkgPath Required]
forall a. Commented a -> a
commented (Commented [Either PkgPath Required] -> [Either PkgPath Required])
-> (PkgManifest -> Commented [Either PkgPath Required])
-> PkgManifest
-> [Either PkgPath Required]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PkgManifest -> Commented [Either PkgPath 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 :: PkgPath -> PkgManifest -> Maybe (PkgManifest, Required)
removeRequiredFromManifest PkgPath
p PkgManifest
pm = do
  Required
r <- PkgPath -> PkgManifest -> Maybe Required
requiredInManifest PkgPath
p PkgManifest
pm
  (PkgManifest, Required) -> Maybe (PkgManifest, Required)
forall (m :: * -> *) a. Monad m => a -> m a
return
    ( PkgManifest
pm {manifestRequire :: Commented [Either PkgPath Required]
manifestRequire = (Either PkgPath Required -> Bool)
-> [Either PkgPath Required] -> [Either PkgPath Required]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool)
-> (Either PkgPath Required -> Bool)
-> Either PkgPath Required
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Either PkgPath Required -> Bool
forall {a}. Either a Required -> Bool
matches) ([Either PkgPath Required] -> [Either PkgPath Required])
-> Commented [Either PkgPath Required]
-> Commented [Either PkgPath Required]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> PkgManifest -> Commented [Either PkgPath 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) ((PkgPath -> PkgPath -> Bool
forall a. Eq a => a -> a -> Bool
== PkgPath
p) (PkgPath -> Bool) -> (Required -> PkgPath) -> Required -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Required -> PkgPath
requiredPkg)

--- Parsing futhark.pkg.

type Parser = Parsec Void T.Text

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

    lexeme' :: ParsecT Void PkgPath Identity a -> ParsecT Void PkgPath Identity a
lexeme' ParsecT Void PkgPath Identity a
p = ParsecT Void PkgPath Identity a
p ParsecT Void PkgPath Identity a
-> ParsecT Void PkgPath Identity FilePath
-> ParsecT Void PkgPath Identity a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT Void PkgPath Identity FilePath
spaceNoEol

    lexstr :: T.Text -> Parser ()
    lexstr :: PkgPath -> ParsecT Void PkgPath Identity ()
lexstr = ParsecT Void PkgPath Identity PkgPath
-> ParsecT Void PkgPath Identity ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ParsecT Void PkgPath Identity PkgPath
 -> ParsecT Void PkgPath Identity ())
-> (PkgPath -> ParsecT Void PkgPath Identity PkgPath)
-> PkgPath
-> ParsecT Void PkgPath Identity ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParsecT Void PkgPath Identity PkgPath
-> ParsecT Void PkgPath Identity PkgPath
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (ParsecT Void PkgPath Identity PkgPath
 -> ParsecT Void PkgPath Identity PkgPath)
-> (PkgPath -> ParsecT Void PkgPath Identity PkgPath)
-> PkgPath
-> ParsecT Void PkgPath Identity PkgPath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParsecT Void PkgPath Identity PkgPath
-> ParsecT Void PkgPath Identity PkgPath
forall a. Parser a -> Parser a
lexeme (ParsecT Void PkgPath Identity PkgPath
 -> ParsecT Void PkgPath Identity PkgPath)
-> (PkgPath -> ParsecT Void PkgPath Identity PkgPath)
-> PkgPath
-> ParsecT Void PkgPath Identity PkgPath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PkgPath -> ParsecT Void PkgPath Identity PkgPath
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 = PkgPath -> ParsecT Void PkgPath Identity ()
lexstr PkgPath
"{" ParsecT Void PkgPath Identity () -> Parser a -> Parser a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser a
p Parser a -> ParsecT Void PkgPath Identity () -> Parser a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* PkgPath -> ParsecT Void PkgPath Identity ()
lexstr PkgPath
"}"

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

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

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

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

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

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

-- | Parse a text as a 'PkgManifest'.  The 'FilePath' is used for any error messages.
parsePkgManifest :: FilePath -> T.Text -> Either (ParseErrorBundle T.Text Void) PkgManifest
parsePkgManifest :: FilePath
-> PkgPath -> Either (ParseErrorBundle PkgPath Void) PkgManifest
parsePkgManifest = Parser PkgManifest
-> FilePath
-> PkgPath
-> Either (ParseErrorBundle PkgPath 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
  PkgPath
s <- FilePath -> IO PkgPath
T.readFile FilePath
f
  case FilePath
-> PkgPath -> Either (ParseErrorBundle PkgPath Void) PkgManifest
parsePkgManifest FilePath
f PkgPath
s of
    Left ParseErrorBundle PkgPath Void
err -> FilePath -> IO PkgManifest
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail (FilePath -> IO PkgManifest) -> FilePath -> IO PkgManifest
forall a b. (a -> b) -> a -> b
$ ParseErrorBundle PkgPath Void -> FilePath
forall s e.
(VisualStream s, TraversableStream s, ShowErrorComponent e) =>
ParseErrorBundle s e -> FilePath
errorBundlePretty ParseErrorBundle PkgPath Void
err
    Right PkgManifest
m -> PkgManifest -> IO PkgManifest
forall (m :: * -> *) a. Monad m => a -> m a
return PkgManifest
m

-- | A mapping from package paths to their chosen revisions.  This is
-- the result of the version solver.
newtype BuildList = BuildList {BuildList -> Map PkgPath 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
/= :: BuildList -> BuildList -> Bool
$c/= :: BuildList -> BuildList -> Bool
== :: BuildList -> BuildList -> Bool
$c== :: 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
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 -> PkgPath
prettyBuildList (BuildList Map PkgPath SemVer
m) = [PkgPath] -> PkgPath
T.unlines ([PkgPath] -> PkgPath) -> [PkgPath] -> PkgPath
forall a b. (a -> b) -> a -> b
$ ((PkgPath, SemVer) -> PkgPath) -> [(PkgPath, SemVer)] -> [PkgPath]
forall a b. (a -> b) -> [a] -> [b]
map (PkgPath, SemVer) -> PkgPath
f ([(PkgPath, SemVer)] -> [PkgPath])
-> [(PkgPath, SemVer)] -> [PkgPath]
forall a b. (a -> b) -> a -> b
$ ((PkgPath, SemVer) -> PkgPath)
-> [(PkgPath, SemVer)] -> [(PkgPath, SemVer)]
forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn (PkgPath, SemVer) -> PkgPath
forall a b. (a, b) -> a
fst ([(PkgPath, SemVer)] -> [(PkgPath, SemVer)])
-> [(PkgPath, SemVer)] -> [(PkgPath, SemVer)]
forall a b. (a -> b) -> a -> b
$ Map PkgPath SemVer -> [(PkgPath, SemVer)]
forall k a. Map k a -> [(k, a)]
M.toList Map PkgPath SemVer
m
  where
    f :: (PkgPath, SemVer) -> PkgPath
f (PkgPath
p, SemVer
v) = [PkgPath] -> PkgPath
T.unwords [PkgPath
p, PkgPath
"=>", SemVer -> PkgPath
prettySemVer SemVer
v]