module Flatpak (
SourceType(..), archive, Source(..),
Module(..), ModuleItem(ModuleEmbed),
Arch(..), archString, T(..),
PackageHook(..), Cabal(..),
) where
import qualified Shell.Utility.ParseArgument as ParseArg
import qualified Cabal.Plan as Plan
import qualified Data.Aeson as Json
import qualified Data.Text as Text
import qualified Data.Monoid.HT as Mn
import Data.Aeson.Types (Parser, Pair)
import Data.Aeson (FromJSON, ToJSON, parseJSON, toJSON, withObject)
import Data.Tuple.HT (mapFst)
import Data.Monoid (mempty, (<>))
import Text.Printf (printf)
import Control.Monad (mzero)
import Control.Applicative (pure, (<*>), (<$>), (<|>))
infixr 8 .:, .:?, .:*
(.:) :: FromJSON a => Json.Object -> String -> Parser a
o .: field = o Json..: Text.pack field
(.:?) :: FromJSON a => Json.Object -> (String, a) -> Parser a
o .:? (field, deflt) = o Json..:? Text.pack field Json..!= deflt
(.:*) :: FromJSON a => Json.Object -> String -> Parser [a]
o .:* field = o .:? (field, [])
infixr 8 .=, .=?, .=*
(.=) :: ToJSON a => String -> (object -> a) -> object -> [Pair]
(field .= a) obj = [Text.pack field Json..= a obj]
(.=?) :: (ToJSON a, Eq a) => String -> (object -> a, a) -> object -> [Pair]
(field .=? (a, deflt)) obj = Mn.when (a obj /= deflt) ((field .= a) obj)
(.=*) :: (ToJSON a) => String -> (object -> [a]) -> object -> [Pair]
(field .=* a) obj = Mn.when (not $ null $ a obj) ((field .= a) obj)
object :: (object -> [Pair]) -> object -> Json.Value
object fields = Json.object . fields
parseEnum ::
(Enum a, Bounded a) => (a -> String) -> String -> Json.Value -> Parser a
parseEnum fmt nm =
Json.withText nm $ \txt ->
case Text.unpack txt of
str ->
case ParseArg.enumMaybe fmt str of
Just x -> return x
Nothing -> fail $ printf "unknown %s type: %s" nm str
data SourceType =
Archive {stripComponents :: Int} |
Git | Bzr | File | Dir | Script | Shell | Patch | ExtraData
deriving (Show)
archive :: SourceType
archive = Archive {stripComponents = 1}
pairsFromSourceType :: SourceType -> [Pair]
pairsFromSourceType t =
let simple str = [("type", Json.toJSON str)]
in map (mapFst Text.pack) $
case t of
Archive {stripComponents = strip} ->
simple "archive" ++
Mn.when (strip/=1) [("strip-components", Json.toJSON strip)]
Git -> simple "git"
Bzr -> simple "bzr"
File -> simple "file"
Dir -> simple "dir"
Script -> simple "script"
Shell -> simple "shell"
Patch -> simple "patch"
ExtraData -> simple "extra-data"
parseSourceType :: Json.Object -> String -> Parser SourceType
parseSourceType obj t =
case t of
"archive" -> fmap Archive $ obj .:? ("strip-components", 1)
"git" -> return Git
"bzr" -> return Bzr
"file" -> return File
"dir" -> return Dir
"script" -> return Script
"shell" -> return Shell
"patch" -> return Patch
"extra-data" -> return ExtraData
_ -> mzero
data Source =
Source {
typ :: SourceType,
url :: String,
destFilename :: Maybe String,
sha256 :: Maybe Plan.Sha256
} deriving (Show)
instance FromJSON Source where
parseJSON =
withObject "Source" $ \o -> pure Source
<*> (parseSourceType o =<< o .: "type")
<*> o .: "url"
<*> o .:? ("dest-filename", Nothing)
<*> o .: "sha256"
instance ToJSON Source where
toJSON = object $
(pairsFromSourceType . typ) <>
("url" .= url) <>
("dest-filename" .=? (destFilename, Nothing)) <>
("sha256" .= sha256) <>
mempty
data Arch = I386 | X86_64 | ARM | AArch64
deriving (Show, Enum, Bounded)
archString :: Arch -> String
archString arch =
case arch of
I386 -> "i386"
X86_64 -> "x86_64"
ARM -> "arm"
AArch64 -> "aarch64"
instance FromJSON Arch where
parseJSON = parseEnum archString "arch"
instance ToJSON Arch where
toJSON = Json.toJSON . archString
data Module =
Module {
name :: String,
onlyArches :: [Arch],
buildsystem :: String,
builddir :: Bool,
configOpts :: [String],
buildCommands :: [String],
postInstall :: [String],
cleanupModule :: [String],
sources :: [Source]
} deriving (Show)
instance FromJSON Module where
parseJSON =
withObject "Module" $ \o -> pure Module
<*> o .: "name"
<*> o .:* "only-arches"
<*> o .: "buildsystem"
<*> o .: "builddir"
<*> o .:* "config-opts"
<*> o .:* "build-commands"
<*> o .:* "post-install"
<*> o .:* "cleanup"
<*> o .:* "sources"
instance ToJSON Module where
toJSON = object $
("name" .= name) <>
("only-arches" .=* onlyArches) <>
("buildsystem" .= buildsystem) <>
("builddir" .= builddir) <>
("config-opts" .=* configOpts) <>
("build-commands" .=* buildCommands) <>
("post-install" .=* postInstall) <>
("cleanup" .=* cleanupModule) <>
("sources" .=* sources) <>
mempty
data ModuleItem = ModuleEmbed Module | ModuleInclude String
deriving (Show)
instance FromJSON ModuleItem where
parseJSON v =
ModuleInclude <$> parseJSON v
<|>
ModuleEmbed <$> parseJSON v
instance ToJSON ModuleItem where
toJSON m =
case m of
ModuleEmbed modu -> toJSON modu
ModuleInclude includePath -> toJSON includePath
data T =
Cons {
appId :: String,
runtime :: String,
runtimeVersion :: String,
sdk :: String,
command :: String,
finishArgs :: [String],
cleanup :: [String],
cleanupCommands :: [String],
modules :: [ModuleItem]
} deriving (Show)
instance FromJSON T where
parseJSON =
withObject "Flatpak" $ \o -> pure Cons
<*> o .: "app-id"
<*> o .: "runtime"
<*> o .: "runtime-version"
<*> o .: "sdk"
<*> o .: "command"
<*> o .: "finish-args"
<*> o .:* "cleanup"
<*> o .:* "cleanup-commands"
<*> o .: "modules"
instance ToJSON T where
toJSON = object $
("app-id" .= appId) <>
("runtime" .= runtime) <>
("runtime-version" .= runtimeVersion) <>
("sdk" .= sdk) <>
("command" .= command) <>
("finish-args" .= finishArgs) <>
("cleanup" .=* cleanup) <>
("cleanup-commands" .=* cleanupCommands) <>
("modules" .= modules) <>
mempty
data PackageHook =
PackageHook {
nameHook :: String,
postInstallHook :: [String]
} deriving (Show)
instance FromJSON PackageHook where
parseJSON =
withObject "PackageHook" $ \o -> pure PackageHook
<*> o .: "name"
<*> o .:* "post-install"
instance ToJSON PackageHook where
toJSON = object $
("name" .= nameHook) <>
("post-install" .=* postInstallHook) <>
mempty
data Cabal =
Cabal {
base :: T,
mainPackage :: String,
mainSources :: [Source],
packageHooks :: [PackageHook],
cabalConfigureOptions, ghcOptions :: [String]
} deriving (Show)
instance FromJSON Cabal where
parseJSON =
withObject "Cabal" $ \o -> pure Cabal
<*> o .: "base"
<*> o .: "main-package"
<*> o .:* "main-sources"
<*> o .:* "package-hooks"
<*> o .:* "cabal-configure-options"
<*> o .:* "ghc-options"
instance ToJSON Cabal where
toJSON = object $
("base" .= base) <>
("main-package" .= mainPackage) <>
("main-sources" .=* mainSources) <>
("package-hooks" .=* packageHooks) <>
("cabal-configure-options" .=* cabalConfigureOptions) <>
("ghc-options" .=* ghcOptions) <>
mempty