{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE NoImplicitPrelude #-}
module Podenv.Config
( load,
select,
Config (..),
Atom (..),
ApplicationRecord (..),
defaultConfigPath,
defaultApp,
loadSystem,
defaultSystemConfig,
podenvImportTxt,
)
where
import Control.Exception (bracket_)
import qualified Data.Digest.Pure.SHA as SHA
import Data.Either.Validation
import qualified Data.Text as Text
import qualified Data.Text.IO as Text (readFile)
import qualified Dhall
import qualified Dhall.Core as Dhall
import qualified Dhall.Import
import qualified Dhall.Map as DM
import Dhall.Marshal.Decode (DhallErrors (..), extractError)
import qualified Dhall.Parser
import qualified Dhall.Src
import Podenv.Dhall hiding (name)
import Podenv.Prelude
import System.Directory
import System.Environment (setEnv, unsetEnv)
import System.FilePath.Posix (dropExtension, isExtensionOf, splitPath)
import qualified Text.Show
data Config
=
ConfigDefault ApplicationRecord
|
ConfigApplication Atom
|
ConfigApplications [(Text, Atom)]
data Atom
=
Lit ApplicationRecord
|
LamArg ArgName (Text -> ApplicationRecord)
| LamArg2 ArgName ArgName (Text -> Text -> ApplicationRecord)
|
LamApp (Application -> ApplicationRecord)
newtype ApplicationRecord = ApplicationRecord {ApplicationRecord -> Application
unRecord :: Application}
instance Dhall.FromDhall ApplicationRecord where
autoWith :: InputNormalizer -> Decoder ApplicationRecord
autoWith = Decoder ApplicationRecord
-> InputNormalizer -> Decoder ApplicationRecord
forall a b. a -> b -> a
const Decoder ApplicationRecord
appRecordDecoder
newtype ArgName = ArgName Text
instance Text.Show.Show ArgName where
show :: ArgName -> String
show (ArgName Text
n) = Text -> String
forall a. ToString a => a -> String
toString Text
n
load :: Maybe Text -> Maybe Text -> IO Config
load :: Maybe Text -> Maybe Text -> IO Config
load Maybe Text
selectorM Maybe Text
configTxt = case Maybe Text
selectorM Maybe Text -> (Text -> Maybe Application) -> Maybe Application
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Text -> Maybe Application
defaultSelector of
Just Application
c -> Config -> IO Config
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Config -> IO Config) -> Config -> IO Config
forall a b. (a -> b) -> a -> b
$ ApplicationRecord -> Config
ConfigDefault (Application -> ApplicationRecord
ApplicationRecord Application
c)
Maybe Application
Nothing -> DhallExpr -> Config
load' (DhallExpr -> Config)
-> (DhallExpr -> DhallExpr) -> DhallExpr -> Config
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DhallExpr -> DhallExpr
forall a s t. Eq a => Expr s a -> Expr t a
Dhall.normalize (DhallExpr -> Config) -> IO DhallExpr -> IO Config
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Text -> IO DhallExpr
loadExpr Maybe Text
configTxt
defaultSelector :: Text -> Maybe Application
defaultSelector :: Text -> Maybe Application
defaultSelector Text
s
| Text
"image:" Text -> Text -> Bool
`Text.isPrefixOf` Text
s = Text -> Maybe Application
imageApp Text
s
| Text
"nix:" Text -> Text -> Bool
`Text.isPrefixOf` Text
s = Text -> Maybe Application
nixApp Text
s
| Text
"nixpkgs#" Text -> Text -> Bool
`Text.isPrefixOf` Text
s = Text -> Maybe Application
nixApp' Text
s
| Text
"rootfs:" Text -> Text -> Bool
`Text.isPrefixOf` Text
s = Text -> Maybe Application
rootfsApp Text
s
| Bool
otherwise = Maybe Application
forall a. Maybe a
Nothing
where
imageApp :: Text -> Maybe Application
imageApp Text
x = Text -> Runtime -> Maybe Application
mkApp (Text
"image-" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
mkName Text
x) (Text -> Runtime
Image (Text -> Runtime) -> Text -> Runtime
forall a b. (a -> b) -> a -> b
$ Int -> Text -> Text
Text.drop (Text -> Int
Text.length Text
"image:") Text
x)
nixApp' :: Text -> Maybe Application
nixApp' Text
x = Text -> Runtime -> Maybe Application
mkApp (Text
"nix-" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
mkName Text
x) (Flakes -> Runtime
Nix (Flakes -> Runtime) -> Flakes -> Runtime
forall a b. (a -> b) -> a -> b
$ [Text] -> Maybe Text -> Flakes
Flakes [Text
x] Maybe Text
forall a. Maybe a
Nothing)
nixApp :: Text -> Maybe Application
nixApp Text
x = Text -> Maybe Application
nixApp' (Text -> Maybe Application) -> Text -> Maybe Application
forall a b. (a -> b) -> a -> b
$ Int -> Text -> Text
Text.drop (Text -> Int
Text.length Text
"nix:") Text
x
rootfsApp :: Text -> Maybe Application
rootfsApp Text
x = Text -> Runtime -> Maybe Application
mkApp (Text
"rootfs-" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
mkName Text
x) (Text -> Runtime
Rootfs (Text -> Runtime) -> Text -> Runtime
forall a b. (a -> b) -> a -> b
$ Int -> Text -> Text
Text.drop (Text -> Int
Text.length Text
"rootfs:") Text
x)
mkApp :: Text -> Runtime -> Maybe Application
mkApp Text
name Runtime
runtime' = Application -> Maybe Application
forall a. a -> Maybe a
Just (Application -> Maybe Application)
-> Application -> Maybe Application
forall a b. (a -> b) -> a -> b
$ Application
defaultApp Application -> (Application -> Application) -> Application
forall a b. a -> (a -> b) -> b
& ((Text -> Identity Text) -> Application -> Identity Application
forall (f :: * -> *).
Functor f =>
(Text -> f Text) -> Application -> f Application
appName ((Text -> Identity Text) -> Application -> Identity Application)
-> Text -> Application -> Application
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Text
name) (Application -> Application)
-> (Application -> Application) -> Application -> Application
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Runtime -> Identity Runtime)
-> Application -> Identity Application
forall (f :: * -> *).
Functor f =>
(Runtime -> f Runtime) -> Application -> f Application
appRuntime ((Runtime -> Identity Runtime)
-> Application -> Identity Application)
-> Runtime -> Application -> Application
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Runtime
runtime')
mkName :: Text -> Text
mkName = Int -> Text -> Text
Text.take Int
6 (Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
forall a. ToText a => a -> Text
toText (String -> Text) -> (Text -> String) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Digest SHA1State -> String
forall t. Digest t -> String
SHA.showDigest (Digest SHA1State -> String)
-> (Text -> Digest SHA1State) -> Text -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Digest SHA1State
SHA.sha1 (ByteString -> Digest SHA1State)
-> (Text -> ByteString) -> Text -> Digest SHA1State
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
forall a b. ConvertUtf8 a b => a -> b
encodeUtf8
loadWithEnv :: FilePath -> Dhall.Expr Dhall.Src.Src Dhall.Import -> IO DhallExpr
loadWithEnv :: String -> Expr Src Import -> IO DhallExpr
loadWithEnv String
baseDir Expr Src Import
expr = IO DhallExpr -> IO DhallExpr
forall c. IO c -> IO c
withEnv (IO DhallExpr -> IO DhallExpr) -> IO DhallExpr -> IO DhallExpr
forall a b. (a -> b) -> a -> b
$ (StateT Status IO DhallExpr -> Status -> IO DhallExpr)
-> Status -> StateT Status IO DhallExpr -> IO DhallExpr
forall a b c. (a -> b -> c) -> b -> a -> c
flip StateT Status IO DhallExpr -> Status -> IO DhallExpr
forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
evalStateT Status
initialState (StateT Status IO DhallExpr -> IO DhallExpr)
-> StateT Status IO DhallExpr -> IO DhallExpr
forall a b. (a -> b) -> a -> b
$ Expr Src Import -> StateT Status IO DhallExpr
Dhall.Import.loadWith Expr Src Import
expr
where
withEnv :: IO c -> IO c
withEnv = IO () -> IO () -> IO c -> IO c
forall a b c. IO a -> IO b -> IO c -> IO c
bracket_ (String -> String -> IO ()
setEnv String
"PODENV" (Text -> String
forall a. ToString a => a -> String
toString Text
podenvImportTxt)) (String -> IO ()
unsetEnv String
"PODENV")
initialState :: Status
initialState = Status
baseStatus Status -> (Status -> Status) -> Status
forall a b. a -> (a -> b) -> b
& LensLike' Identity Status (URL -> StateT Status IO Text)
forall (f :: * -> *).
Functor f =>
LensLike' f Status (URL -> StateT Status IO Text)
Dhall.Import.remote LensLike' Identity Status (URL -> StateT Status IO Text)
-> (URL -> StateT Status IO Text) -> Status -> Status
forall s t a b. ASetter s t a b -> b -> s -> t
.~ URL -> StateT Status IO Text
fetchUrl
baseStatus :: Status
baseStatus = String -> Status
Dhall.Import.emptyStatus String
baseDir
fetchUrl :: URL -> StateT Status IO Text
fetchUrl URL
url
| URL
url URL -> URL -> Bool
forall a. Eq a => a -> a -> Bool
== URL
podenvUrl = Text -> StateT Status IO Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Expr Void Void -> Text
forall a. Pretty a => a -> Text
Dhall.pretty Expr Void Void
podenvPackage)
| Bool
otherwise = (Status
baseStatus Status
-> FoldLike
(URL -> StateT Status IO Text)
Status
Status
(URL -> StateT Status IO Text)
(URL -> StateT Status IO Text)
-> URL
-> StateT Status IO Text
forall s a t b. s -> FoldLike a s t a b -> a
^. FoldLike
(URL -> StateT Status IO Text)
Status
Status
(URL -> StateT Status IO Text)
(URL -> StateT Status IO Text)
forall (f :: * -> *).
Functor f =>
LensLike' f Status (URL -> StateT Status IO Text)
Dhall.Import.remote) URL
url
loadExpr :: Maybe Text -> IO DhallExpr
loadExpr :: Maybe Text -> IO DhallExpr
loadExpr Maybe Text
configM = case Maybe Text
configM of
Just Text
configTxt -> do
String
cwd' <- IO String
getCurrentDirectory
String -> Expr Src Import -> IO DhallExpr
loadWithEnv String
cwd' (Expr Src Import -> IO DhallExpr)
-> Expr Src Import -> IO DhallExpr
forall a b. (a -> b) -> a -> b
$ Text -> Expr Src Import
exprFromText' Text
configTxt
Maybe Text
Nothing -> do
String
baseDir <- IO String
getConfigDir
let configPath :: String
configPath = String
baseDir String -> ShowS
</> String
"config.dhall"
Text
configContent <-
IO Text -> IO Text -> Bool -> IO Text
forall a. a -> a -> Bool -> a
bool (Text -> IO Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
"(env:PODENV).Hub") (String -> IO Text
Text.readFile String
configPath) (Bool -> IO Text) -> IO Bool -> IO Text
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< String -> IO Bool
doesFileExist String
configPath
let configExpr :: Expr Src Import
configExpr = Text -> Expr Src Import
exprFromText' Text
configContent
let locald :: String
locald = String
baseDir String -> ShowS
</> String
"local.d"
[String]
localFiles <- IO [String] -> IO [String] -> Bool -> IO [String]
forall a. a -> a -> Bool -> a
bool ([String] -> IO [String]
forall (f :: * -> *) a. Applicative f => a -> f a
pure []) (String -> IO [String]
listDirectory String
locald) (Bool -> IO [String]) -> IO Bool -> IO [String]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< String -> IO Bool
doesPathExist String
locald
let localConfig :: Expr Src Import
localConfig = String -> [String] -> Expr Src Import
createLocalRecord String
locald [String]
localFiles
let expr' :: Expr Src Import
expr' = Maybe CharacterSet
-> PreferAnnotation Src Import
-> Expr Src Import
-> Expr Src Import
-> Expr Src Import
forall s a.
Maybe CharacterSet
-> PreferAnnotation s a -> Expr s a -> Expr s a -> Expr s a
Dhall.Prefer Maybe CharacterSet
forall a. Maybe a
Nothing PreferAnnotation Src Import
forall s a. PreferAnnotation s a
Dhall.PreferFromSource Expr Src Import
configExpr Expr Src Import
localConfig
String -> Expr Src Import -> IO DhallExpr
loadWithEnv String
baseDir Expr Src Import
expr'
where
exprFromText' :: Text -> Dhall.Expr Dhall.Src.Src Dhall.Import
exprFromText' :: Text -> Expr Src Import
exprFromText' Text
configTxt = case String -> Text -> Either ParseError (Expr Src Import)
Dhall.Parser.exprFromText String
"<config>" Text
configTxt of
Right Expr Src Import
expr -> Expr Src Import
expr
Left ParseError
e -> Text -> Expr Src Import
forall a t. (HasCallStack, IsText t) => t -> a
error (Text -> Expr Src Import) -> Text -> Expr Src Import
forall a b. (a -> b) -> a -> b
$ Text
"Invalid config: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ParseError -> Text
forall b a. (Show a, IsString b) => a -> b
show ParseError
e
createLocalRecord :: FilePath -> [FilePath] -> Dhall.Expr Dhall.Src.Src Dhall.Import
createLocalRecord :: String -> [String] -> Expr Src Import
createLocalRecord String
baseDir =
Map Text (RecordField Src Import) -> Expr Src Import
forall s a. Map Text (RecordField s a) -> Expr s a
Dhall.RecordLit (Map Text (RecordField Src Import) -> Expr Src Import)
-> ([String] -> Map Text (RecordField Src Import))
-> [String]
-> Expr Src Import
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Text, RecordField Src Import)]
-> Map Text (RecordField Src Import)
forall l. IsList l => [Item l] -> l
fromList ([(Text, RecordField Src Import)]
-> Map Text (RecordField Src Import))
-> ([String] -> [(Text, RecordField Src Import)])
-> [String]
-> Map Text (RecordField Src Import)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> (Text, RecordField Src Import))
-> [String] -> [(Text, RecordField Src Import)]
forall a b. (a -> b) -> [a] -> [b]
map String -> (Text, RecordField Src Import)
toRecord ([String] -> [(Text, RecordField Src Import)])
-> ([String] -> [String])
-> [String]
-> [(Text, RecordField Src Import)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> Bool) -> [String] -> [String]
forall a. (a -> Bool) -> [a] -> [a]
filter (String -> String -> Bool
isExtensionOf String
".dhall")
where
toRecord :: FilePath -> (Text, Dhall.RecordField Dhall.Src.Src Dhall.Import)
toRecord :: String -> (Text, RecordField Src Import)
toRecord String
name = (String -> Text
forall a. ToText a => a -> Text
toText (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ ShowS
dropExtension String
name, Expr Src Import -> RecordField Src Import
forall s a. Expr s a -> RecordField s a
Dhall.makeRecordField (Import -> Expr Src Import
forall s a. a -> Expr s a
Dhall.Embed (Import -> Expr Src Import) -> Import -> Expr Src Import
forall a b. (a -> b) -> a -> b
$ String -> Import
toImport String
name))
toImport :: FilePath -> Dhall.Import
toImport :: String -> Import
toImport String
name =
let file :: File
file = Directory -> Text -> File
Dhall.File ([Text] -> Directory
Dhall.Directory ([Text] -> Directory) -> [Text] -> Directory
forall a b. (a -> b) -> a -> b
$ [Text] -> [Text]
forall a. [a] -> [a]
reverse ([Text] -> [Text]) -> [Text] -> [Text]
forall a b. (a -> b) -> a -> b
$ (String -> Text) -> [String] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map String -> Text
forall a. ToText a => a -> Text
toText ([String] -> [Text]) -> [String] -> [Text]
forall a b. (a -> b) -> a -> b
$ String -> [String]
splitPath String
baseDir) (String -> Text
forall a. ToText a => a -> Text
toText String
name)
in ImportHashed -> ImportMode -> Import
Dhall.Import (Maybe SHA256Digest -> ImportType -> ImportHashed
Dhall.ImportHashed Maybe SHA256Digest
forall a. Maybe a
Nothing (FilePrefix -> File -> ImportType
Dhall.Local FilePrefix
Dhall.Absolute File
file)) ImportMode
Dhall.Code
podenvUrl :: Dhall.URL
podenvUrl :: URL
podenvUrl =
Scheme
-> Text -> File -> Maybe Text -> Maybe (Expr Src Import) -> URL
Dhall.URL Scheme
Dhall.HTTPS Text
"raw.githubusercontent.com" File
path Maybe Text
forall a. Maybe a
Nothing Maybe (Expr Src Import)
forall a. Maybe a
Nothing
where
hubVersion :: Text
hubVersion = case Decoder Text -> DhallExpr -> Extractor Src Void Text
forall a. Decoder a -> DhallExpr -> Extractor Src Void a
Dhall.extract Decoder Text
forall a. FromDhall a => Decoder a
Dhall.auto (Expr Void Void -> DhallExpr
forall a s. Expr Void a -> Expr s a
Dhall.renote Expr Void Void
hubCommit) of
Success Text
x -> Int -> Text -> Text
Text.dropEnd Int
1 Text
x
Failure ExtractErrors Src Void
v -> Text -> Text
forall a t. (HasCallStack, IsText t) => t -> a
error (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Text
"Unknown hub commit: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ExtractErrors Src Void -> Text
forall b a. (Show a, IsString b) => a -> b
show ExtractErrors Src Void
v
path :: File
path = Directory -> Text -> File
Dhall.File ([Text] -> Directory
Dhall.Directory [Text
hubVersion, Text
"hub", Text
"podenv"]) Text
"package.dhall"
podenvImport :: Dhall.Import
podenvImport :: Import
podenvImport =
ImportHashed -> ImportMode -> Import
Dhall.Import (Maybe SHA256Digest -> ImportType -> ImportHashed
Dhall.ImportHashed (SHA256Digest -> Maybe SHA256Digest
forall a. a -> Maybe a
Just SHA256Digest
hash) (URL -> ImportType
Dhall.Remote URL
podenvUrl)) ImportMode
Dhall.Code
where
hash :: SHA256Digest
hash = Expr Void Void -> SHA256Digest
Dhall.Import.hashExpression (Expr Void Void -> Expr Void Void
forall s a. Expr s a -> Expr s a
Dhall.alphaNormalize Expr Void Void
podenvPackage)
podenvImportTxt :: Text
podenvImportTxt :: Text
podenvImportTxt = Text -> Text -> Text -> Text
Text.replace Text
"\n " Text
"" (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Import -> Text
forall a. Pretty a => a -> Text
Dhall.pretty Import
podenvImport
load' :: DhallExpr -> Config
load' :: DhallExpr -> Config
load' DhallExpr
expr = case Text -> DhallExpr -> DhallParser [(Text, Atom)]
loadConfig Text
"" DhallExpr
expr of
Success [(Text
selector, Lit ApplicationRecord
app)] -> Atom -> Config
ConfigApplication (Atom -> Config) -> Atom -> Config
forall a b. (a -> b) -> a -> b
$ ApplicationRecord -> Atom
Lit (Text -> ApplicationRecord -> ApplicationRecord
ensureName Text
selector ApplicationRecord
app)
Success [(Text
_, Atom
x)] -> Atom -> Config
ConfigApplication Atom
x
Success [] -> Text -> Config
forall a t. (HasCallStack, IsText t) => t -> a
error Text
"No application found"
Success [(Text, Atom)]
xs -> [(Text, Atom)] -> Config
ConfigApplications [(Text, Atom)]
xs
Failure (DhallErrors (ExtractError Src Void
x :| [ExtractError Src Void]
_)) -> Text -> Config
forall a t. (HasCallStack, IsText t) => t -> a
error (Text -> Config) -> Text -> Config
forall a b. (a -> b) -> a -> b
$ ExtractError Src Void -> Text
forall b a. (Show a, IsString b) => a -> b
show ExtractError Src Void
x
ensureName :: Text -> ApplicationRecord -> ApplicationRecord
ensureName :: Text -> ApplicationRecord -> ApplicationRecord
ensureName Text
x ApplicationRecord
app = case ApplicationRecord -> Application
unRecord ApplicationRecord
app Application
-> FoldLike Text Application Application Text Text -> Text
forall s a t b. s -> FoldLike a s t a b -> a
^. FoldLike Text Application Application Text Text
forall (f :: * -> *).
Functor f =>
(Text -> f Text) -> Application -> f Application
appName of
Text
"" -> Application -> ApplicationRecord
ApplicationRecord (Application -> ApplicationRecord)
-> Application -> ApplicationRecord
forall a b. (a -> b) -> a -> b
$ ApplicationRecord -> Application
unRecord ApplicationRecord
app Application -> (Application -> Application) -> Application
forall a b. a -> (a -> b) -> b
& (Text -> Identity Text) -> Application -> Identity Application
forall (f :: * -> *).
Functor f =>
(Text -> f Text) -> Application -> f Application
appName ((Text -> Identity Text) -> Application -> Identity Application)
-> Text -> Application -> Application
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Text
x
Text
_ -> ApplicationRecord
app
loadConfig :: Text -> DhallExpr -> DhallParser [(Text, Atom)]
loadConfig :: Text -> DhallExpr -> DhallParser [(Text, Atom)]
loadConfig Text
baseSelector DhallExpr
expr = case DhallExpr
expr of
Dhall.Lam {} -> (\Atom
app -> [(Text
baseSelector, Atom
app)]) (Atom -> [(Text, Atom)])
-> Validation (ExtractErrors Src Void) Atom
-> DhallParser [(Text, Atom)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> DhallExpr -> Validation (ExtractErrors Src Void) Atom
loadApp DhallExpr
expr
Dhall.RecordLit Map Text (RecordField Src Void)
kv
|
Text -> Map Text (RecordField Src Void) -> Bool
forall k v. Ord k => k -> Map k v -> Bool
DM.member Text
"runtime" Map Text (RecordField Src Void)
kv ->
(\Atom
app -> [(Text
baseSelector, Atom
app)]) (Atom -> [(Text, Atom)])
-> Validation (ExtractErrors Src Void) Atom
-> DhallParser [(Text, Atom)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> DhallExpr -> Validation (ExtractErrors Src Void) Atom
loadApp DhallExpr
expr
|
Bool
otherwise ->
[[(Text, Atom)]] -> [(Text, Atom)]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[(Text, Atom)]] -> [(Text, Atom)])
-> Validation (ExtractErrors Src Void) [[(Text, Atom)]]
-> DhallParser [(Text, Atom)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((Text, RecordField Src Void) -> DhallParser [(Text, Atom)])
-> [(Text, RecordField Src Void)]
-> Validation (ExtractErrors Src Void) [[(Text, Atom)]]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse ((Text -> RecordField Src Void -> DhallParser [(Text, Atom)])
-> (Text, RecordField Src Void) -> DhallParser [(Text, Atom)]
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Text -> RecordField Src Void -> DhallParser [(Text, Atom)]
loadCollection) (Map Text (RecordField Src Void) -> [(Text, RecordField Src Void)]
forall k v. Ord k => Map k v -> [(k, v)]
DM.toList Map Text (RecordField Src Void)
kv)
where
loadCollection :: Text -> RecordField Src Void -> DhallParser [(Text, Atom)]
loadCollection Text
n RecordField Src Void
e
| Text
"use" Text -> Text -> Bool
`Text.isPrefixOf` Text
n = [(Text, Atom)] -> DhallParser [(Text, Atom)]
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
| Bool
otherwise = Text -> DhallExpr -> DhallParser [(Text, Atom)]
loadConfig (Text -> Text
mkSelector Text
n) (RecordField Src Void -> DhallExpr
forall s a. RecordField s a -> Expr s a
Dhall.recordFieldValue RecordField Src Void
e)
mkSelector :: Text -> Text
mkSelector Text
name
| Text
baseSelector Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
forall a. Monoid a => a
mempty = Text
name
| Text
name Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"default" = Text
baseSelector
| Bool
otherwise = Text
baseSelector Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"." Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
name
DhallExpr
_ -> Text -> DhallParser [(Text, Atom)]
forall s a b. Text -> Extractor s a b
extractError (Text -> DhallParser [(Text, Atom)])
-> Text -> DhallParser [(Text, Atom)]
forall a b. (a -> b) -> a -> b
$ Text
baseSelector Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
": expected a record literal, but got: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text -> Text
Text.take Int
256 (DhallExpr -> Text
forall b a. (Show a, IsString b) => a -> b
show DhallExpr
expr)
select :: Config -> [Text] -> Either Text ([Text], Application)
select :: Config -> [Text] -> Either Text ([Text], Application)
select Config
config [Text]
args = (ApplicationRecord -> Application)
-> ([Text], ApplicationRecord) -> ([Text], Application)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ApplicationRecord -> Application
unRecord (([Text], ApplicationRecord) -> ([Text], Application))
-> Either Text ([Text], ApplicationRecord)
-> Either Text ([Text], Application)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Config -> [Text] -> Either Text ([Text], ApplicationRecord)
select' Config
config [Text]
args
select' :: Config -> [Text] -> Either Text ([Text], ApplicationRecord)
select' :: Config -> [Text] -> Either Text ([Text], ApplicationRecord)
select' Config
config [Text]
args = case Config
config of
ConfigDefault ApplicationRecord
app -> ([Text], ApplicationRecord)
-> Either Text ([Text], ApplicationRecord)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (NonEmpty Text -> [Text]
forall (f :: * -> *) a. IsNonEmpty f a [a] "tail" => f a -> [a]
tail ([Item (NonEmpty Text)] -> NonEmpty Text
forall l. IsList l => [Item l] -> l
fromList [Text]
[Item (NonEmpty Text)]
args), ApplicationRecord
app)
ConfigApplication Atom
atom -> [(Text, Atom)]
-> [Text] -> Atom -> Either Text ([Text], ApplicationRecord)
selectApp [] [Text]
args Atom
atom
ConfigApplications [(Text, Atom)]
atoms -> case [Text]
args of
(Text
selector : [Text]
xs) -> do
Atom
atom <- Text -> [(Text, Atom)] -> Maybe Atom
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
selector [(Text, Atom)]
atoms Maybe Atom -> Text -> Either Text Atom
forall a. Maybe a -> Text -> Either Text a
`orDie` (Text
selector Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
": not found")
([Text]
args', ApplicationRecord
app) <- [(Text, Atom)]
-> [Text] -> Atom -> Either Text ([Text], ApplicationRecord)
selectApp [(Text, Atom)]
atoms [Text]
xs Atom
atom
let name' :: Text
name' = Text -> [Text] -> Text
Text.intercalate Text
"-" ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ Int -> [Text] -> [Text]
forall a. Int -> [a] -> [a]
take ([Text] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Text]
args Int -> Int -> Int
forall a. Num a => a -> a -> a
- [Text] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Text]
args') [Text]
args
([Text], ApplicationRecord)
-> Either Text ([Text], ApplicationRecord)
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Text]
args', Text -> ApplicationRecord -> ApplicationRecord
ensureName Text
name' ApplicationRecord
app)
[] -> Text -> Either Text ([Text], ApplicationRecord)
forall a b. a -> Either a b
Left Text
"Multiple apps configured, provides a selector"
where
selectApp :: [(Text, Atom)]
-> [Text] -> Atom -> Either Text ([Text], ApplicationRecord)
selectApp [(Text, Atom)]
atoms [Text]
args' Atom
atom = case Atom
atom of
Lit ApplicationRecord
app -> ([Text], ApplicationRecord)
-> Either Text ([Text], ApplicationRecord)
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Text]
args', ApplicationRecord
app)
LamArg ArgName
arg Text -> ApplicationRecord
f -> case [Text]
args' of
(Text
x : [Text]
xs) -> ([Text], ApplicationRecord)
-> Either Text ([Text], ApplicationRecord)
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Text]
xs, Text -> ApplicationRecord
f Text
x)
[] -> Text -> Either Text ([Text], ApplicationRecord)
forall a b. a -> Either a b
Left (Text
"Missing argument: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ArgName -> Text
forall b a. (Show a, IsString b) => a -> b
show ArgName
arg)
LamArg2 ArgName
arg1 ArgName
arg2 Text -> Text -> ApplicationRecord
f -> case [Text]
args' of
(Text
x : Text
y : [Text]
xs) -> ([Text], ApplicationRecord)
-> Either Text ([Text], ApplicationRecord)
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Text]
xs, Text -> Text -> ApplicationRecord
f Text
x Text
y)
(Text
_ : [Text]
_) -> Text -> Either Text ([Text], ApplicationRecord)
forall a b. a -> Either a b
Left (Text
"Missing argument: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ArgName -> Text
forall b a. (Show a, IsString b) => a -> b
show ArgName
arg2)
[Text]
_ -> Text -> Either Text ([Text], ApplicationRecord)
forall a b. a -> Either a b
Left (Text
"Missing arguments: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ArgName -> Text
forall b a. (Show a, IsString b) => a -> b
show ArgName
arg1 Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ArgName -> Text
forall b a. (Show a, IsString b) => a -> b
show ArgName
arg2)
LamApp Application -> ApplicationRecord
f -> case [Text]
args' of
(Text
x : [Text]
xs) -> case Text -> Maybe Application
defaultSelector Text
x of
Just Application
app -> ([Text], ApplicationRecord)
-> Either Text ([Text], ApplicationRecord)
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Text]
xs, Application -> ApplicationRecord
f Application
app)
Maybe Application
Nothing -> do
Atom
atom' <- Text -> [(Text, Atom)] -> Maybe Atom
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
x [(Text, Atom)]
atoms Maybe Atom -> Text -> Either Text Atom
forall a. Maybe a -> Text -> Either Text a
`orDie` (Text
x Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
": unknown lam arg")
([Text]
rest, ApplicationRecord
app) <- [(Text, Atom)]
-> [Text] -> Atom -> Either Text ([Text], ApplicationRecord)
selectApp [(Text, Atom)]
atoms [Text]
xs Atom
atom'
([Text], ApplicationRecord)
-> Either Text ([Text], ApplicationRecord)
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Text]
rest, Application -> ApplicationRecord
f (ApplicationRecord -> Application
unRecord ApplicationRecord
app))
[] -> Text -> Either Text ([Text], ApplicationRecord)
forall a b. a -> Either a b
Left Text
"Missing app argument"
defaultConfigPath :: Text
defaultConfigPath :: Text
defaultConfigPath = Text
"~/.config/podenv/config.dhall"
defaultApp :: Application
defaultApp :: Application
defaultApp = case Decoder Application -> DhallExpr -> Extractor Src Void Application
forall a. Decoder a -> DhallExpr -> Extractor Src Void a
Dhall.extract Decoder Application
forall a. FromDhall a => Decoder a
Dhall.auto (Expr Void Void -> DhallExpr
forall a s. Expr Void a -> Expr s a
Dhall.renote Expr Void Void
appDefault) of
Success Application
app -> Application
app
Failure ExtractErrors Src Void
v -> Text -> Application
forall a t. (HasCallStack, IsText t) => t -> a
error (Text -> Application) -> Text -> Application
forall a b. (a -> b) -> a -> b
$ Text
"Invalid default application: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ExtractErrors Src Void -> Text
forall b a. (Show a, IsString b) => a -> b
show ExtractErrors Src Void
v
type DhallParser a = Dhall.Extractor Dhall.Src.Src Void a
type DhallExpr = Dhall.Expr Dhall.Src.Src Void
type a = Dhall.Extractor Dhall.Src.Src Void a
pref :: Dhall.Expr s a -> Dhall.Expr s a -> Dhall.Expr s a
pref :: Expr s a -> Expr s a -> Expr s a
pref = Maybe CharacterSet
-> PreferAnnotation s a -> Expr s a -> Expr s a -> Expr s a
forall s a.
Maybe CharacterSet
-> PreferAnnotation s a -> Expr s a -> Expr s a -> Expr s a
Dhall.Prefer Maybe CharacterSet
forall a. Maybe a
Nothing PreferAnnotation s a
forall s a. PreferAnnotation s a
Dhall.PreferFromSource
mkRecord :: [(Text, Dhall.Expr s a)] -> Dhall.Expr s a
mkRecord :: [(Text, Expr s a)] -> Expr s a
mkRecord [(Text, Expr s a)]
kv = Map Text (RecordField s a) -> Expr s a
forall s a. Map Text (RecordField s a) -> Expr s a
Dhall.RecordLit (Expr s a -> RecordField s a
forall s a. Expr s a -> RecordField s a
Dhall.makeRecordField (Expr s a -> RecordField s a)
-> Map Text (Expr s a) -> Map Text (RecordField s a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Text, Expr s a)] -> Map Text (Expr s a)
forall k v. Ord k => [(k, v)] -> Map k v
DM.fromList [(Text, Expr s a)]
kv)
recordItems :: DM.Map Text (Dhall.RecordField s a) -> [(Text, Dhall.Expr Void a)]
recordItems :: Map Text (RecordField s a) -> [(Text, Expr Void a)]
recordItems Map Text (RecordField s a)
kv = (RecordField s a -> Expr Void a)
-> (Text, RecordField s a) -> (Text, Expr Void a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Expr s a -> Expr Void a
forall s a t. Expr s a -> Expr t a
Dhall.denote (Expr s a -> Expr Void a)
-> (RecordField s a -> Expr s a) -> RecordField s a -> Expr Void a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RecordField s a -> Expr s a
forall s a. RecordField s a -> Expr s a
Dhall.recordFieldValue) ((Text, RecordField s a) -> (Text, Expr Void a))
-> [(Text, RecordField s a)] -> [(Text, Expr Void a)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Map Text (RecordField s a) -> [(Text, RecordField s a)]
forall k v. Ord k => Map k v -> [(k, v)]
DM.toList Map Text (RecordField s a)
kv
appRecordDecoder :: Dhall.Decoder ApplicationRecord
appRecordDecoder :: Decoder ApplicationRecord
appRecordDecoder = Application -> ApplicationRecord
ApplicationRecord (Application -> ApplicationRecord)
-> Decoder Application -> Decoder ApplicationRecord
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (DhallExpr -> Extractor Src Void Application)
-> Expector DhallExpr -> Decoder Application
forall a.
(DhallExpr -> Extractor Src Void a)
-> Expector DhallExpr -> Decoder a
Dhall.Decoder DhallExpr -> Extractor Src Void Application
extract Expector DhallExpr
forall e s. Validation e (Expr s Void)
expected
where
extract :: Dhall.Expr Dhall.Src.Src Void -> DhallExtractor Application
extract :: DhallExpr -> Extractor Src Void Application
extract (Dhall.RecordLit Map Text (RecordField Src Void)
kv) = case Text
-> Map Text (RecordField Src Void) -> Maybe (RecordField Src Void)
forall k v. Ord k => k -> Map k v -> Maybe v
DM.lookup Text
"runtime" Map Text (RecordField Src Void)
kv of
Just (Dhall.RecordField Maybe Src
_ (Dhall.RecordLit Map Text (RecordField Src Void)
kv') Maybe Src
_ Maybe Src
_) -> Map Text (RecordField Src Void)
-> Expr Void Void -> Extractor Src Void Application
forall s.
Map Text (RecordField s Void)
-> Expr Void Void -> Extractor Src Void Application
extract' Map Text (RecordField Src Void)
kv (Map Text (RecordField Src Void) -> Expr Void Void
forall s. Map Text (RecordField s Void) -> Expr Void Void
runtimeFromRecord Map Text (RecordField Src Void)
kv')
Just (Dhall.RecordField Maybe Src
_ DhallExpr
v Maybe Src
_ Maybe Src
_) -> Map Text (RecordField Src Void)
-> Expr Void Void -> Extractor Src Void Application
forall s.
Map Text (RecordField s Void)
-> Expr Void Void -> Extractor Src Void Application
extract' Map Text (RecordField Src Void)
kv (DhallExpr -> Expr Void Void
forall s a t. Expr s a -> Expr t a
Dhall.denote DhallExpr
v)
Maybe (RecordField Src Void)
Nothing -> Text -> Extractor Src Void Application
forall s a b. Text -> Extractor s a b
Dhall.extractError Text
"Application does not have a runtime"
extract DhallExpr
_ = Text -> Extractor Src Void Application
forall s a b. Text -> Extractor s a b
Dhall.extractError Text
"Application is not a record"
runtimeFromRecord :: DM.Map Text (Dhall.RecordField s Void) -> Dhall.Expr Void Void
runtimeFromRecord :: Map Text (RecordField s Void) -> Expr Void Void
runtimeFromRecord Map Text (RecordField s Void)
kv = case Map Text (RecordField s Void) -> [(Text, Expr Void Void)]
forall s a. Map Text (RecordField s a) -> [(Text, Expr Void a)]
recordItems Map Text (RecordField s Void)
kv of
[(Text
"image", Expr Void Void
x)] -> Text -> Expr Void Void -> Expr Void Void
mkRuntime Text
"Image" Expr Void Void
x
[(Text
"nix", Expr Void Void
x)] -> Text -> Expr Void Void -> Expr Void Void
mkRuntime Text
"Nix" (Expr Void Void -> Expr Void Void
forall s a. Expr s a -> Expr s a
mkNixRecord Expr Void Void
x)
[(Text
"containerfile", Expr Void Void
x)] -> Text -> Expr Void Void -> Expr Void Void
mkRuntime Text
"Container" (Expr Void Void -> Expr Void Void -> Expr Void Void
forall s a. Expr s a -> Expr s a -> Expr s a
pref Expr Void Void
containerBuildDefault ([(Text, Expr Void Void)] -> Expr Void Void
forall s a. [(Text, Expr s a)] -> Expr s a
mkRecord [(Text
"containerfile", Expr Void Void
x)]))
[(Text, Expr Void Void)]
_ -> Text -> Expr Void Void -> Expr Void Void
mkRuntime Text
"Container" (Expr Void Void -> Expr Void Void -> Expr Void Void
forall s a. Expr s a -> Expr s a -> Expr s a
pref Expr Void Void
containerBuildDefault (Expr s Void -> Expr Void Void
forall s a t. Expr s a -> Expr t a
Dhall.denote (Map Text (RecordField s Void) -> Expr s Void
forall s a. Map Text (RecordField s a) -> Expr s a
Dhall.RecordLit Map Text (RecordField s Void)
kv)))
where
mkNixRecord :: Expr s a -> Expr s a
mkNixRecord Expr s a
v =
[(Text, Expr s a)] -> Expr s a
forall s a. [(Text, Expr s a)] -> Expr s a
mkRecord
[ (Text
"installables", Maybe (Expr s a) -> Seq (Expr s a) -> Expr s a
forall s a. Maybe (Expr s a) -> Seq (Expr s a) -> Expr s a
Dhall.ListLit Maybe (Expr s a)
forall a. Maybe a
Nothing (Seq (Expr s a) -> Expr s a) -> Seq (Expr s a) -> Expr s a
forall a b. (a -> b) -> a -> b
$ [Item (Seq (Expr s a))] -> Seq (Expr s a)
forall l. IsList l => [Item l] -> l
fromList [Item (Seq (Expr s a))
Expr s a
v]),
(Text
"nixpkgs", Expr s a -> Expr s a -> Expr s a
forall s a. Expr s a -> Expr s a -> Expr s a
Dhall.App Expr s a
forall s a. Expr s a
Dhall.None Expr s a
forall s a. Expr s a
Dhall.Text)
]
mkRuntime :: Text -> Expr Void Void -> Expr Void Void
mkRuntime Text
field Expr Void Void
v =
Expr Void Void -> Expr Void Void -> Expr Void Void
forall s a. Expr s a -> Expr s a -> Expr s a
Dhall.App (Expr Void Void -> FieldSelection Void -> Expr Void Void
forall s a. Expr s a -> FieldSelection s -> Expr s a
Dhall.Field Expr Void Void
runtimeType (Maybe Void -> Text -> Maybe Void -> FieldSelection Void
forall s. Maybe s -> Text -> Maybe s -> FieldSelection s
Dhall.FieldSelection Maybe Void
forall a. Maybe a
Nothing Text
field Maybe Void
forall a. Maybe a
Nothing)) Expr Void Void
v
extract' :: DM.Map Text (Dhall.RecordField s Void) -> Dhall.Expr Void Void -> DhallExtractor Application
extract' :: Map Text (RecordField s Void)
-> Expr Void Void -> Extractor Src Void Application
extract' Map Text (RecordField s Void)
kv Expr Void Void
runtimeExpr =
let capsExpr :: Expr Void Void
capsExpr = case Text -> Map Text (RecordField s Void) -> Maybe (RecordField s Void)
forall k v. Ord k => k -> Map k v -> Maybe v
DM.lookup Text
"capabilities" Map Text (RecordField s Void)
kv of
Just (Dhall.RecordField Maybe s
_ Expr s Void
v Maybe s
_ Maybe s
_) -> Expr Void Void -> Expr Void Void -> Expr Void Void
forall s a. Expr s a -> Expr s a -> Expr s a
pref Expr Void Void
capsDefault (Expr s Void -> Expr Void Void
forall s a t. Expr s a -> Expr t a
Dhall.denote Expr s Void
v)
Maybe (RecordField s Void)
_ -> Expr Void Void
capsDefault
nestedSchemas :: [(Text, Expr Void Void)]
nestedSchemas = [(Text
"capabilities", Expr Void Void
capsExpr), (Text
"runtime", Expr Void Void
runtimeExpr)]
baseExpr :: Expr Void Void
baseExpr = Expr Void Void -> Expr Void Void -> Expr Void Void
forall s a. Expr s a -> Expr s a -> Expr s a
pref (Expr s Void -> Expr Void Void
forall s a t. Expr s a -> Expr t a
Dhall.denote (Expr s Void -> Expr Void Void) -> Expr s Void -> Expr Void Void
forall a b. (a -> b) -> a -> b
$ Map Text (RecordField s Void) -> Expr s Void
forall s a. Map Text (RecordField s a) -> Expr s a
Dhall.RecordLit Map Text (RecordField s Void)
kv) ([(Text, Expr Void Void)] -> Expr Void Void
forall s a. [(Text, Expr s a)] -> Expr s a
mkRecord [(Text, Expr Void Void)]
nestedSchemas)
expr :: Expr Void Void
expr = Expr Void Void -> Expr Void Void -> Expr Void Void
forall s a. Expr s a -> Expr s a -> Expr s a
pref Expr Void Void
appDefault Expr Void Void
baseExpr
Dhall.Decoder DhallExpr -> Extractor Src Void Application
appDecoder Expector DhallExpr
_ = Decoder Application
forall a. (Generic a, GenericFromDhall a (Rep a)) => Decoder a
Dhall.genericAuto
in DhallExpr -> Extractor Src Void Application
appDecoder (Expr Void Void -> DhallExpr
forall a s. Expr Void a -> Expr s a
Dhall.renote (Expr Void Void -> Expr Void Void
forall a s t. Eq a => Expr s a -> Expr t a
Dhall.normalize Expr Void Void
expr))
expected :: Validation e (Expr s Void)
expected = Expr s Void -> Validation e (Expr s Void)
forall e a. a -> Validation e a
Success (Expr Void Void -> Expr s Void
forall a s. Expr Void a -> Expr s a
Dhall.renote Expr Void Void
appType)
loadApp :: DhallExpr -> DhallParser Atom
loadApp :: DhallExpr -> Validation (ExtractErrors Src Void) Atom
loadApp DhallExpr
expr = case DhallExpr
expr of
Dhall.Lam Maybe CharacterSet
_ FunctionBinding Src Void
fb1 (Dhall.Lam Maybe CharacterSet
_ FunctionBinding Src Void
fb2 DhallExpr
_) -> ArgName -> ArgName -> (Text -> Text -> ApplicationRecord) -> Atom
LamArg2 (FunctionBinding Src Void -> ArgName
forall s a. FunctionBinding s a -> ArgName
getArgName FunctionBinding Src Void
fb1) (FunctionBinding Src Void -> ArgName
forall s a. FunctionBinding s a -> ArgName
getArgName FunctionBinding Src Void
fb2) ((Text -> Text -> ApplicationRecord) -> Atom)
-> Validation
(ExtractErrors Src Void) (Text -> Text -> ApplicationRecord)
-> Validation (ExtractErrors Src Void) Atom
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder (Text -> Text -> ApplicationRecord)
-> DhallExpr
-> Validation
(ExtractErrors Src Void) (Text -> Text -> ApplicationRecord)
forall a. Decoder a -> DhallExpr -> Extractor Src Void a
Dhall.extract Decoder (Text -> Text -> ApplicationRecord)
forall a. FromDhall a => Decoder a
Dhall.auto DhallExpr
expr
Dhall.Lam Maybe CharacterSet
_ FunctionBinding Src Void
fb DhallExpr
_
| DhallExpr -> Expr Void Void
forall s a t. Expr s a -> Expr t a
Dhall.denote (FunctionBinding Src Void -> DhallExpr
forall s a. FunctionBinding s a -> Expr s a
Dhall.functionBindingAnnotation FunctionBinding Src Void
fb) Expr Void Void -> Expr Void Void -> Bool
forall a. Eq a => a -> a -> Bool
== Expr Void Void
appType ->
(Application -> ApplicationRecord) -> Atom
LamApp ((Application -> ApplicationRecord) -> Atom)
-> Validation
(ExtractErrors Src Void) (Application -> ApplicationRecord)
-> Validation (ExtractErrors Src Void) Atom
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder (Application -> ApplicationRecord)
-> DhallExpr
-> Validation
(ExtractErrors Src Void) (Application -> ApplicationRecord)
forall a. Decoder a -> DhallExpr -> Extractor Src Void a
Dhall.extract Decoder (Application -> ApplicationRecord)
forall a. FromDhall a => Decoder a
Dhall.auto DhallExpr
expr
| Bool
otherwise -> ArgName -> (Text -> ApplicationRecord) -> Atom
LamArg (FunctionBinding Src Void -> ArgName
forall s a. FunctionBinding s a -> ArgName
getArgName FunctionBinding Src Void
fb) ((Text -> ApplicationRecord) -> Atom)
-> Validation (ExtractErrors Src Void) (Text -> ApplicationRecord)
-> Validation (ExtractErrors Src Void) Atom
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder (Text -> ApplicationRecord)
-> DhallExpr
-> Validation (ExtractErrors Src Void) (Text -> ApplicationRecord)
forall a. Decoder a -> DhallExpr -> Extractor Src Void a
Dhall.extract Decoder (Text -> ApplicationRecord)
forall a. FromDhall a => Decoder a
Dhall.auto DhallExpr
expr
DhallExpr
_ -> ApplicationRecord -> Atom
Lit (ApplicationRecord -> Atom)
-> Validation (ExtractErrors Src Void) ApplicationRecord
-> Validation (ExtractErrors Src Void) Atom
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder ApplicationRecord
-> DhallExpr
-> Validation (ExtractErrors Src Void) ApplicationRecord
forall a. Decoder a -> DhallExpr -> Extractor Src Void a
Dhall.extract Decoder ApplicationRecord
forall a. FromDhall a => Decoder a
Dhall.auto DhallExpr
expr
where
getArgName :: FunctionBinding s a -> ArgName
getArgName = Text -> ArgName
ArgName (Text -> ArgName)
-> (FunctionBinding s a -> Text) -> FunctionBinding s a -> ArgName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FunctionBinding s a -> Text
forall s a. FunctionBinding s a -> Text
Dhall.functionBindingVariable
loadSystem :: IO SystemConfig
loadSystem :: IO SystemConfig
loadSystem = do
String
confDir <- XdgDirectory -> String -> IO String
getXdgDirectory XdgDirectory
XdgConfig String
"podenv"
let fp :: String
fp = String
confDir String -> ShowS
</> String
"system.dhall"
Bool
exist <- String -> IO Bool
doesFileExist String
fp
if Bool
exist
then Decoder SystemConfig -> Text -> IO SystemConfig
forall a. Decoder a -> Text -> IO a
Dhall.input Decoder SystemConfig
forall a. FromDhall a => Decoder a
Dhall.auto (String -> Text
forall a. ToText a => a -> Text
toText String
fp)
else SystemConfig -> IO SystemConfig
forall (f :: * -> *) a. Applicative f => a -> f a
pure SystemConfig
defaultSystemConfig
defaultSystemConfig :: SystemConfig
defaultSystemConfig :: SystemConfig
defaultSystemConfig = case Decoder SystemConfig
-> DhallExpr -> Extractor Src Void SystemConfig
forall a. Decoder a -> DhallExpr -> Extractor Src Void a
Dhall.extract Decoder SystemConfig
forall a. FromDhall a => Decoder a
Dhall.auto (Expr Void Void -> DhallExpr
forall a s. Expr Void a -> Expr s a
Dhall.renote Expr Void Void
systemConfigDefault) of
Success SystemConfig
x -> SystemConfig
x
Failure ExtractErrors Src Void
v -> Text -> SystemConfig
forall a t. (HasCallStack, IsText t) => t -> a
error (Text -> SystemConfig) -> Text -> SystemConfig
forall a b. (a -> b) -> a -> b
$ Text
"Invalid default system config: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ExtractErrors Src Void -> Text
forall b a. (Show a, IsString b) => a -> b
show ExtractErrors Src Void
v