Copyright | (c) 2021-2022 berberman |
---|---|
License | MIT |
Maintainer | berberman <[email protected]> |
Stability | experimental |
Portability | portable |
Safe Haskell | Safe-Inferred |
Language | Haskell2010 |
This module mainly contains two things: PackageSet
and PkgDSL
.
NvFetcher accepts the former one -- a set of packages to produce nix sources expr;
the later one is used to construct a single package.
There are many combinators for defining packages. See the documentation of define
for example.
Synopsis
- data PackageSetF f
- type PackageSet = Free PackageSetF
- newPackage :: PackageName -> CheckVersion -> PackageFetcher -> Maybe PackageExtractSrc -> Maybe PackageCargoLockFiles -> PackagePassthru -> UseStaleVersion -> DateFormat -> ForceFetch -> PackageSet ()
- purePackageSet :: [Package] -> PackageSet ()
- runPackageSet :: PackageSet () -> IO (Map PackageKey Package)
- class PkgDSL f where
- new :: f PackageName -> f (Prod '[PackageName])
- andThen :: f (Prod r) -> f a -> f (Prod (a ': r))
- end :: (Members '[PackageName, VersionSource, PackageFetcher] r, OptionalMembers '[PackageExtractSrc, PackageCargoLockFiles, NvcheckerOptions, PackagePassthru, UseStaleVersion, DateFormat, ForceFetch] r) => f (Prod r) -> f ()
- define :: (Members '[PackageName, VersionSource, PackageFetcher] r, OptionalMembers '[PackageExtractSrc, PackageCargoLockFiles, PackagePassthru, NvcheckerOptions, UseStaleVersion, DateFormat, ForceFetch] r) => PackageSet (Prod r) -> PackageSet ()
- package :: PackageName -> PackageSet (Prod '[PackageName])
- src :: Attach VersionSource VersionSource
- fetch :: Attach PackageFetcher PackageFetcher
- fromGitHub :: AttachMany '[PackageFetcher, VersionSource] (Text, Text)
- fromGitHub' :: AttachMany '[PackageFetcher, VersionSource] (Text, Text, NixFetcher Fresh -> NixFetcher Fresh)
- fromGitHubTag :: AttachMany '[PackageFetcher, VersionSource] (Text, Text, ListOptions -> ListOptions)
- fromGitHubTag' :: AttachMany '[PackageFetcher, VersionSource] (Text, Text, ListOptions -> ListOptions, NixFetcher Fresh -> NixFetcher Fresh)
- fromPypi :: AttachMany '[PackageFetcher, VersionSource] Text
- fromOpenVsx :: AttachMany '[PackagePassthru, PackageFetcher, VersionSource] (Text, Text)
- fromVscodeMarketplace :: AttachMany '[PackagePassthru, PackageFetcher, VersionSource] (Text, Text)
- sourceGitHub :: Attach VersionSource (Text, Text)
- sourceGitHubTag :: Attach VersionSource (Text, Text, ListOptions -> ListOptions)
- sourceGit :: Attach VersionSource Text
- sourceGit' :: Attach VersionSource (Text, Text)
- sourcePypi :: Attach VersionSource Text
- sourceAur :: Attach VersionSource Text
- sourceArchLinux :: Attach VersionSource Text
- sourceManual :: Attach VersionSource Text
- sourceRepology :: Attach VersionSource (Text, Text)
- sourceWebpage :: Attach VersionSource (Text, Text, ListOptions -> ListOptions)
- sourceHttpHeader :: Attach VersionSource (Text, Text, ListOptions -> ListOptions)
- sourceOpenVsx :: Attach VersionSource (Text, Text)
- sourceVscodeMarketplace :: Attach VersionSource (Text, Text)
- sourceCmd :: Attach VersionSource Text
- fetchGitHub :: Attach PackageFetcher (Text, Text)
- fetchGitHub' :: Attach PackageFetcher (Text, Text, NixFetcher Fresh -> NixFetcher Fresh)
- fetchGitHubRelease :: Attach PackageFetcher (Text, Text, Text)
- fetchGitHubRelease' :: Attach PackageFetcher (Text, Text, Version -> Text)
- fetchPypi :: Attach PackageFetcher Text
- fetchGit :: Attach PackageFetcher Text
- fetchGit' :: Attach PackageFetcher (Text, NixFetcher Fresh -> NixFetcher Fresh)
- fetchUrl :: Attach PackageFetcher (Version -> Text)
- fetchUrl' :: Attach PackageFetcher (Text, Version -> Text)
- fetchOpenVsx :: Attach PackageFetcher (Text, Text)
- fetchVscodeMarketplace :: Attach PackageFetcher (Text, Text)
- fetchTarball :: Attach PackageFetcher (Version -> Text)
- extractSource :: Attach PackageExtractSrc [FilePath]
- hasCargoLocks :: Attach PackageCargoLockFiles [FilePath]
- tweakVersion :: Attach NvcheckerOptions (NvcheckerOptions -> NvcheckerOptions)
- passthru :: Attach PackagePassthru [(Text, Text)]
- pinned :: PackageSet (Prod r) -> PackageSet (Prod (UseStaleVersion : r))
- gitDateFormat :: Attach DateFormat (Maybe Text)
- forceFetch :: PackageSet (Prod r) -> PackageSet (Prod (ForceFetch : r))
- data Prod (r :: [Type])
- type family Append xs ys where ...
- class Member (a :: Type) (r :: [Type])
- class OptionalMember (a :: Type) (r :: [Type])
- type family NotElem (x :: Type) (xs :: [Type]) :: Constraint where ...
- type family Members xs r :: Constraint where ...
- type family OptionalMembers xs r :: Constraint where ...
- type Attach x arg = AttachMany '[x] arg
- type AttachMany xs arg = forall r. PackageSet (Prod r) -> arg -> PackageSet (Prod (Append xs r))
- coerce :: forall {k :: RuntimeRep} (a :: TYPE k) (b :: TYPE k). Coercible a b => a -> b
- liftIO :: MonadIO m => IO a -> m a
- (&) :: a -> (a -> b) -> b
- (.~) :: ASetter s t a b -> b -> s -> t
- (%~) :: ASetter s t a b -> (a -> b) -> s -> t
- (^.) :: s -> Getting a s a -> a
- (?~) :: ASetter s t a (Maybe b) -> b -> s -> t
- module NvFetcher.Types.Lens
Package set
data PackageSetF f Source #
Atomic terms of package set
Instances
MonadIO PackageSet Source # | |
Defined in NvFetcher.PackageSet liftIO :: IO a -> PackageSet a # | |
Functor PackageSetF Source # | |
Defined in NvFetcher.PackageSet fmap :: (a -> b) -> PackageSetF a -> PackageSetF b # (<$) :: a -> PackageSetF b -> PackageSetF a # | |
PkgDSL PackageSet Source # | |
Defined in NvFetcher.PackageSet new :: PackageSet PackageName -> PackageSet (Prod '[PackageName]) Source # andThen :: forall (r :: [Type]) a. PackageSet (Prod r) -> PackageSet a -> PackageSet (Prod (a ': r)) Source # end :: forall (r :: [Type]). (Members '[PackageName, VersionSource, PackageFetcher] r, OptionalMembers '[PackageExtractSrc, PackageCargoLockFiles, NvcheckerOptions, PackagePassthru, UseStaleVersion, DateFormat, ForceFetch] r) => PackageSet (Prod r) -> PackageSet () Source # |
type PackageSet = Free PackageSetF Source #
Package set is a monad equipped with two capabilities:
- Carry defined packages
- Run IO actions
Package set is evaluated before shake runs.
Use newPackage
to add a new package, liftIO
to run an IO action.
newPackage :: PackageName -> CheckVersion -> PackageFetcher -> Maybe PackageExtractSrc -> Maybe PackageCargoLockFiles -> PackagePassthru -> UseStaleVersion -> DateFormat -> ForceFetch -> PackageSet () Source #
Add a package to package set
purePackageSet :: [Package] -> PackageSet () Source #
Add a list of packages into package set
runPackageSet :: PackageSet () -> IO (Map PackageKey Package) Source #
Run package set into a set of packages
Throws exception as more then one packages with the same name are defined
Package DSL
Primitives
A tagless final style DSL for constructing packages
new :: f PackageName -> f (Prod '[PackageName]) Source #
andThen :: f (Prod r) -> f a -> f (Prod (a ': r)) Source #
end :: (Members '[PackageName, VersionSource, PackageFetcher] r, OptionalMembers '[PackageExtractSrc, PackageCargoLockFiles, NvcheckerOptions, PackagePassthru, UseStaleVersion, DateFormat, ForceFetch] r) => f (Prod r) -> f () Source #
Instances
PkgDSL PackageSet Source # | |
Defined in NvFetcher.PackageSet new :: PackageSet PackageName -> PackageSet (Prod '[PackageName]) Source # andThen :: forall (r :: [Type]) a. PackageSet (Prod r) -> PackageSet a -> PackageSet (Prod (a ': r)) Source # end :: forall (r :: [Type]). (Members '[PackageName, VersionSource, PackageFetcher] r, OptionalMembers '[PackageExtractSrc, PackageCargoLockFiles, NvcheckerOptions, PackagePassthru, UseStaleVersion, DateFormat, ForceFetch] r) => PackageSet (Prod r) -> PackageSet () Source # |
define :: (Members '[PackageName, VersionSource, PackageFetcher] r, OptionalMembers '[PackageExtractSrc, PackageCargoLockFiles, PackagePassthru, NvcheckerOptions, UseStaleVersion, DateFormat, ForceFetch] r) => PackageSet (Prod r) -> PackageSet () Source #
PkgDSL
version of newPackage
Example:
define $ package "nvfetcher-git"sourceGit
"https://github.com/berberman/nvfetcher"fetchGitHub
("berberman", "nvfetcher")
package :: PackageName -> PackageSet (Prod '[PackageName]) Source #
Start chaining with the name of package to define
src :: Attach VersionSource VersionSource Source #
Attach version sources
fetch :: Attach PackageFetcher PackageFetcher Source #
Attach fetchers
Two-in-one functions
fromGitHub :: AttachMany '[PackageFetcher, VersionSource] (Text, Text) Source #
A synonym of fetchGitHub
and sourceGitHub
fromGitHub' :: AttachMany '[PackageFetcher, VersionSource] (Text, Text, NixFetcher Fresh -> NixFetcher Fresh) Source #
A synonym of fetchGitHub'
and sourceGitHub
fromGitHubTag :: AttachMany '[PackageFetcher, VersionSource] (Text, Text, ListOptions -> ListOptions) Source #
A synonym of fetchGitHub
and sourceGitHubTag
fromGitHubTag' :: AttachMany '[PackageFetcher, VersionSource] (Text, Text, ListOptions -> ListOptions, NixFetcher Fresh -> NixFetcher Fresh) Source #
A synonym of fetchGitHub'
and sourceGitHubTag
fromPypi :: AttachMany '[PackageFetcher, VersionSource] Text Source #
A synonym of fetchPypi
and sourcePypi
fromOpenVsx :: AttachMany '[PackagePassthru, PackageFetcher, VersionSource] (Text, Text) Source #
A synonym of fetchOpenVsx
, sourceOpenVsx
, and passthru
extension's publisher with name
fromVscodeMarketplace :: AttachMany '[PackagePassthru, PackageFetcher, VersionSource] (Text, Text) Source #
A synonym of fetchVscodeMarketplace
, sourceVscodeMarketplace
, and passthru
extension's publisher with name
Version sources
sourceGitHub :: Attach VersionSource (Text, Text) Source #
This package follows the latest github release
sourceGitHubTag :: Attach VersionSource (Text, Text, ListOptions -> ListOptions) Source #
This package follows the a tag from github
Args are owner, repo, and nvchecker list options to find the target tag
sourceGit :: Attach VersionSource Text Source #
This package follows the latest git commit
Arg is git url
sourceGit' :: Attach VersionSource (Text, Text) Source #
Similar to sourceGit
, but allows to specify branch
Args are git url and branch
sourcePypi :: Attach VersionSource Text Source #
This package follows the latest pypi release
Arg is pypi name
sourceAur :: Attach VersionSource Text Source #
This package follows the version of an Aur package
Arg is package name in Aur
sourceArchLinux :: Attach VersionSource Text Source #
This package follows the version of an Arch Linux package
Arg is package name in Arch Linux repo
sourceManual :: Attach VersionSource Text Source #
This package follows a pinned version
Arg is manual version
sourceRepology :: Attach VersionSource (Text, Text) Source #
This package follows the version of a repology package
Args are repology project name and repo
sourceWebpage :: Attach VersionSource (Text, Text, ListOptions -> ListOptions) Source #
This package follows a version extracted from web page
Args are web page url, regex, and list options
sourceHttpHeader :: Attach VersionSource (Text, Text, ListOptions -> ListOptions) Source #
This package follows a version extracted from http header
Args are the url of the http request, regex, and list options
sourceOpenVsx :: Attach VersionSource (Text, Text) Source #
This package follows a version in Open VSX
Args are publisher and extension name
sourceVscodeMarketplace :: Attach VersionSource (Text, Text) Source #
This package follows a version in Vscode Marketplace
Args are publisher and extension name
sourceCmd :: Attach VersionSource Text Source #
This package follows a version from a shell command
Arg is the command to run
Fetchers
fetchGitHub :: Attach PackageFetcher (Text, Text) Source #
This package is fetched from a github repo
Args are owner and repo
fetchGitHub' :: Attach PackageFetcher (Text, Text, NixFetcher Fresh -> NixFetcher Fresh) Source #
This package is fetched from a github repo
Similar to fetchGitHub
, but allows a modifier to the fetcher.
For example, you can enable fetch submodules like:
define $ package "qliveplayer"sourceGitHub
(THMonster, QLivePlayer)fetchGitHub'
(THMonster, QLivePlayer, fetchSubmodules .~ True)
fetchGitHubRelease :: Attach PackageFetcher (Text, Text, Text) Source #
This package is fetched from a file in github release
Args are owner, repo, and file name
fetchGitHubRelease' :: Attach PackageFetcher (Text, Text, Version -> Text) Source #
This package is fetched from a file in github release
Args are owner, repo, and file name computed from version
fetchGit' :: Attach PackageFetcher (Text, NixFetcher Fresh -> NixFetcher Fresh) Source #
This package is fetched from git
Similar to fetchGit
, but allows a modifier to the fetcher.
See fetchGitHub'
for a concret example.
fetchUrl :: Attach PackageFetcher (Version -> Text) Source #
This package is fetched from url
Arg is a function which constructs the url from a version
fetchUrl' :: Attach PackageFetcher (Text, Version -> Text) Source #
This package is fetched from url
Args are a function which constructs the url from a version and a file name
fetchOpenVsx :: Attach PackageFetcher (Text, Text) Source #
This package is fetched from Open VSX
Args are publisher and extension name
fetchVscodeMarketplace :: Attach PackageFetcher (Text, Text) Source #
This package is fetched from Vscode Marketplace
Args are publisher and extension name
fetchTarball :: Attach PackageFetcher (Version -> Text) Source #
This package is a tarball, fetched from url
Arg is a function which constructs the url from a version
Addons
extractSource :: Attach PackageExtractSrc [FilePath] Source #
Extract files from fetched package source
hasCargoLocks :: Attach PackageCargoLockFiles [FilePath] Source #
Run FetchRustGitDependencies
given the path to Cargo.lock
files
The lock files will be extracted as well.
tweakVersion :: Attach NvcheckerOptions (NvcheckerOptions -> NvcheckerOptions) Source #
Set NvcheckerOptions
for a package, which can tweak the version number we obtain
passthru :: Attach PackagePassthru [(Text, Text)] Source #
An attrs set to pass through
Arg is a list of kv pairs
pinned :: PackageSet (Prod r) -> PackageSet (Prod (UseStaleVersion : r)) Source #
Pin a package
new version won't be checked if we have a stale version
gitDateFormat :: Attach DateFormat (Maybe Text) Source #
Specify the date format for getting git commit date
Available only for git version source
forceFetch :: PackageSet (Prod r) -> PackageSet (Prod (ForceFetch : r)) Source #
Set always fetching regardless of the version changing
Miscellaneous
class Member (a :: Type) (r :: [Type]) Source #
Project elements from Prod
proj
Instances
(TypeError ('ShowType x ':<>: 'Text " is undefined") :: Constraint) => Member x ('[] :: [Type]) Source # | |
Defined in NvFetcher.PackageSet | |
Member x xs => Member x (_y ': xs) Source # | |
Defined in NvFetcher.PackageSet | |
NotElem x xs => Member x (x ': xs) Source # | |
Defined in NvFetcher.PackageSet |
class OptionalMember (a :: Type) (r :: [Type]) Source #
Project optional elements from Prod
projMaybe
Instances
OptionalMember x ('[] :: [Type]) Source # | |
Defined in NvFetcher.PackageSet | |
OptionalMember x xs => OptionalMember x (_y ': xs) Source # | |
Defined in NvFetcher.PackageSet | |
NotElem x xs => OptionalMember x (x ': xs) Source # | |
Defined in NvFetcher.PackageSet |
type family NotElem (x :: Type) (xs :: [Type]) :: Constraint where ... Source #
Constraint for producing error messages
type family Members xs r :: Constraint where ... Source #
A list of Member
type family OptionalMembers xs r :: Constraint where ... Source #
A list of OptionalMember
OptionalMembers '[] _ = () | |
OptionalMembers (x ': xs) r = (OptionalMember x r, OptionalMembers xs r) |
type Attach x arg = AttachMany '[x] arg Source #
Attach member x
, with a function arg
type AttachMany xs arg = forall r. PackageSet (Prod r) -> arg -> PackageSet (Prod (Append xs r)) Source #
Attach members xs
, with a function argument arg
coerce :: forall {k :: RuntimeRep} (a :: TYPE k) (b :: TYPE k). Coercible a b => a -> b #
The function coerce
allows you to safely convert between values of
types that have the same representation with no run-time overhead. In the
simplest case you can use it instead of a newtype constructor, to go from
the newtype's concrete type to the abstract type. But it also works in
more complicated settings, e.g. converting a list of newtypes to a list of
concrete types.
When used in conversions involving a newtype wrapper, make sure the newtype constructor is in scope.
This function is representation-polymorphic, but the
RuntimeRep
type argument is marked as Inferred
, meaning
that it is not available for visible type application. This means
the typechecker will accept
.coerce
@Int
@Age 42
Examples
>>>
newtype TTL = TTL Int deriving (Eq, Ord, Show)
>>>
newtype Age = Age Int deriving (Eq, Ord, Show)
>>>
coerce (Age 42) :: TTL
TTL 42>>>
coerce (+ (1 :: Int)) (Age 42) :: TTL
TTL 43>>>
coerce (map (+ (1 :: Int))) [Age 42, Age 24] :: [TTL]
[TTL 43,TTL 25]
liftIO :: MonadIO m => IO a -> m a #
Lift a computation from the IO
monad.
This allows us to run IO computations in any monadic stack, so long as it supports these kinds of operations
(i.e. IO
is the base monad for the stack).
Example
import Control.Monad.Trans.State -- from the "transformers" library printState :: Show s => StateT s IO () printState = do state <- get liftIO $ print state
Had we omitted
, we would have ended up with this error:liftIO
• Couldn't match type ‘IO’ with ‘StateT s IO’ Expected type: StateT s IO () Actual type: IO ()
The important part here is the mismatch between StateT s IO ()
and
.IO
()
Luckily, we know of a function that takes an
and returns an IO
a(m a)
:
,
enabling us to run the program and see the expected results:liftIO
> evalStateT printState "hello" "hello" > evalStateT printState 3 3
Lenses
(%~) :: ASetter s t a b -> (a -> b) -> s -> t infixr 4 #
(%~
) applies a function to the target; an alternative explanation is that it is an inverse of sets
, which turns a setter into an ordinary function.
is the same thing as mapped
%~
reverse
.fmap
reverse
See over
if you want a non-operator synonym.
Negating the 1st element of a pair:
>>>
(1,2) & _1 %~ negate
(-1,2)
Turning all Left
s in a list to upper case:
>>>
(mapped._Left.mapped %~ toUpper) [Left "foo", Right "bar"]
[Left "FOO",Right "bar"]
(^.) :: s -> Getting a s a -> a infixl 8 #
(^.
) applies a getter to a value; in other words, it gets a value out of a structure using a getter (which can be a lens, traversal, fold, etc.).
Getting 1st field of a tuple:
(^.
_1
) :: (a, b) -> a (^.
_1
) =fst
When (^.
) is used with a traversal, it combines all results using the Monoid
instance for the resulting type. For instance, for lists it would be simple concatenation:
>>>
("str","ing") ^. each
"string"
The reason for this is that traversals use Applicative
, and the Applicative
instance for Const
uses monoid concatenation to combine “effects” of Const
.
A non-operator version of (^.
) is called view
, and it's a bit more general than (^.
) (it works in MonadReader
). If you need the general version, you can get it from microlens-mtl; otherwise there's view
available in Lens.Micro.Extras.
module NvFetcher.Types.Lens