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