{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedLists #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}

module Cabal2JSON
  ( cabal2JSON,
  )
where

import Autodocodec
import Control.Arrow (first)
import Data.Aeson (FromJSON, ToJSON)
import qualified Data.ByteString.Char8 as SB8
import qualified Data.ByteString.Lazy as LB
import qualified Data.HashMap.Strict as HM
import Data.Hashable
import qualified Data.List.NonEmpty as NE
import qualified Data.Text as T
import Data.Text.Encoding
import Distribution.Compiler as Cabal
import Distribution.License as Cabal
import Distribution.ModuleName as Cabal
import Distribution.PackageDescription
import Distribution.PackageDescription.Parsec as Cabal
import Distribution.Parsec (eitherParsec)
import Distribution.Pretty as Pretty
import Distribution.SPDX (LicenseExpression (..), SimpleLicenseExpression (..))
import qualified Distribution.SPDX as SPDX
import Distribution.SPDX.License as SPDX
import Distribution.System
import Distribution.Types.CondTree as Cabal
import Distribution.Types.Dependency as Cabal
import Distribution.Types.ExeDependency as Cabal
import Distribution.Types.ExecutableScope as Cabal
import Distribution.Types.ForeignLib as Cabal
import Distribution.Types.ForeignLibOption as Cabal
import Distribution.Types.ForeignLibType as Cabal
import Distribution.Types.IncludeRenaming as Cabal
import Distribution.Types.LegacyExeDependency as Cabal
import Distribution.Types.LibraryVisibility as Cabal
import Distribution.Types.Mixin as Cabal
import Distribution.Types.PackageId as Cabal
import Distribution.Types.PackageName as Cabal
import Distribution.Types.PkgconfigDependency as Cabal
import Distribution.Types.PkgconfigName
import Distribution.Types.PkgconfigVersion
import Distribution.Types.PkgconfigVersionRange
import Distribution.Types.UnqualComponentName as Cabal
import Distribution.Types.Version as Cabal
import Distribution.Types.VersionRange as Cabal
import Distribution.Utils.ShortText as Cabal
import Distribution.Verbosity as Cabal
import Language.Haskell.Extension
import System.Environment

cabal2JSON :: IO ()
cabal2JSON :: IO ()
cabal2JSON = do
  [String]
args <- IO [String]
getArgs
  case [String]
args of
    [] -> String -> IO ()
forall a. HasCallStack => String -> a
error String
"Please provide path to cabal file as CLI argument"
    [String]
arg -> do
      GenericPackageDescription
genericPackageDescription <- Verbosity -> String -> IO GenericPackageDescription
Cabal.readGenericPackageDescription Verbosity
Cabal.deafening ([String] -> String
forall a. [a] -> a
head [String]
arg)
      ByteString -> IO ()
SB8.putStrLn (ByteString -> IO ()) -> ByteString -> IO ()
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
LB.toStrict (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ GenericPackageDescription -> ByteString
forall a. HasCodec a => a -> ByteString
encodeJSONViaCodec GenericPackageDescription
genericPackageDescription

instance HasCodec GenericPackageDescription where
  codec :: JSONCodec GenericPackageDescription
codec =
    Text
-> ObjectCodec GenericPackageDescription GenericPackageDescription
-> JSONCodec GenericPackageDescription
forall input output.
Text -> ObjectCodec input output -> ValueCodec input output
object Text
"GenericPackageDescription" (ObjectCodec GenericPackageDescription GenericPackageDescription
 -> JSONCodec GenericPackageDescription)
-> ObjectCodec GenericPackageDescription GenericPackageDescription
-> JSONCodec GenericPackageDescription
forall a b. (a -> b) -> a -> b
$
      PackageDescription
-> [Flag]
-> Maybe (CondTree ConfVar [Dependency] Library)
-> [(UnqualComponentName, CondTree ConfVar [Dependency] Library)]
-> [(UnqualComponentName,
     CondTree ConfVar [Dependency] ForeignLib)]
-> [(UnqualComponentName,
     CondTree ConfVar [Dependency] Executable)]
-> [(UnqualComponentName, CondTree ConfVar [Dependency] TestSuite)]
-> [(UnqualComponentName, CondTree ConfVar [Dependency] Benchmark)]
-> GenericPackageDescription
GenericPackageDescription
        (PackageDescription
 -> [Flag]
 -> Maybe (CondTree ConfVar [Dependency] Library)
 -> [(UnqualComponentName, CondTree ConfVar [Dependency] Library)]
 -> [(UnqualComponentName,
      CondTree ConfVar [Dependency] ForeignLib)]
 -> [(UnqualComponentName,
      CondTree ConfVar [Dependency] Executable)]
 -> [(UnqualComponentName, CondTree ConfVar [Dependency] TestSuite)]
 -> [(UnqualComponentName, CondTree ConfVar [Dependency] Benchmark)]
 -> GenericPackageDescription)
-> Codec Object GenericPackageDescription PackageDescription
-> Codec
     Object
     GenericPackageDescription
     ([Flag]
      -> Maybe (CondTree ConfVar [Dependency] Library)
      -> [(UnqualComponentName, CondTree ConfVar [Dependency] Library)]
      -> [(UnqualComponentName,
           CondTree ConfVar [Dependency] ForeignLib)]
      -> [(UnqualComponentName,
           CondTree ConfVar [Dependency] Executable)]
      -> [(UnqualComponentName, CondTree ConfVar [Dependency] TestSuite)]
      -> [(UnqualComponentName, CondTree ConfVar [Dependency] Benchmark)]
      -> GenericPackageDescription)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> ObjectCodec PackageDescription PackageDescription
forall output. HasCodec output => Text -> ObjectCodec output output
requiredField' Text
"description" ObjectCodec PackageDescription PackageDescription
-> (GenericPackageDescription -> PackageDescription)
-> Codec Object GenericPackageDescription PackageDescription
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
.= GenericPackageDescription -> PackageDescription
packageDescription
        Codec
  Object
  GenericPackageDescription
  ([Flag]
   -> Maybe (CondTree ConfVar [Dependency] Library)
   -> [(UnqualComponentName, CondTree ConfVar [Dependency] Library)]
   -> [(UnqualComponentName,
        CondTree ConfVar [Dependency] ForeignLib)]
   -> [(UnqualComponentName,
        CondTree ConfVar [Dependency] Executable)]
   -> [(UnqualComponentName, CondTree ConfVar [Dependency] TestSuite)]
   -> [(UnqualComponentName, CondTree ConfVar [Dependency] Benchmark)]
   -> GenericPackageDescription)
-> Codec Object GenericPackageDescription [Flag]
-> Codec
     Object
     GenericPackageDescription
     (Maybe (CondTree ConfVar [Dependency] Library)
      -> [(UnqualComponentName, CondTree ConfVar [Dependency] Library)]
      -> [(UnqualComponentName,
           CondTree ConfVar [Dependency] ForeignLib)]
      -> [(UnqualComponentName,
           CondTree ConfVar [Dependency] Executable)]
      -> [(UnqualComponentName, CondTree ConfVar [Dependency] TestSuite)]
      -> [(UnqualComponentName, CondTree ConfVar [Dependency] Benchmark)]
      -> GenericPackageDescription)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text -> [Flag] -> ObjectCodec [Flag] [Flag]
forall output.
(Eq output, HasCodec output) =>
Text -> output -> ObjectCodec output output
optionalFieldWithOmittedDefault' Text
"package-flags" [] ObjectCodec [Flag] [Flag]
-> (GenericPackageDescription -> [Flag])
-> Codec Object GenericPackageDescription [Flag]
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
.= GenericPackageDescription -> [Flag]
genPackageFlags
        Codec
  Object
  GenericPackageDescription
  (Maybe (CondTree ConfVar [Dependency] Library)
   -> [(UnqualComponentName, CondTree ConfVar [Dependency] Library)]
   -> [(UnqualComponentName,
        CondTree ConfVar [Dependency] ForeignLib)]
   -> [(UnqualComponentName,
        CondTree ConfVar [Dependency] Executable)]
   -> [(UnqualComponentName, CondTree ConfVar [Dependency] TestSuite)]
   -> [(UnqualComponentName, CondTree ConfVar [Dependency] Benchmark)]
   -> GenericPackageDescription)
-> Codec
     Object
     GenericPackageDescription
     (Maybe (CondTree ConfVar [Dependency] Library))
-> Codec
     Object
     GenericPackageDescription
     ([(UnqualComponentName, CondTree ConfVar [Dependency] Library)]
      -> [(UnqualComponentName,
           CondTree ConfVar [Dependency] ForeignLib)]
      -> [(UnqualComponentName,
           CondTree ConfVar [Dependency] Executable)]
      -> [(UnqualComponentName, CondTree ConfVar [Dependency] TestSuite)]
      -> [(UnqualComponentName, CondTree ConfVar [Dependency] Benchmark)]
      -> GenericPackageDescription)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text
-> ObjectCodec
     (Maybe (CondTree ConfVar [Dependency] Library))
     (Maybe (CondTree ConfVar [Dependency] Library))
forall output.
HasCodec output =>
Text -> ObjectCodec (Maybe output) (Maybe output)
optionalField' Text
"library" ObjectCodec
  (Maybe (CondTree ConfVar [Dependency] Library))
  (Maybe (CondTree ConfVar [Dependency] Library))
-> (GenericPackageDescription
    -> Maybe (CondTree ConfVar [Dependency] Library))
-> Codec
     Object
     GenericPackageDescription
     (Maybe (CondTree ConfVar [Dependency] Library))
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
.= GenericPackageDescription
-> Maybe (CondTree ConfVar [Dependency] Library)
condLibrary
        Codec
  Object
  GenericPackageDescription
  ([(UnqualComponentName, CondTree ConfVar [Dependency] Library)]
   -> [(UnqualComponentName,
        CondTree ConfVar [Dependency] ForeignLib)]
   -> [(UnqualComponentName,
        CondTree ConfVar [Dependency] Executable)]
   -> [(UnqualComponentName, CondTree ConfVar [Dependency] TestSuite)]
   -> [(UnqualComponentName, CondTree ConfVar [Dependency] Benchmark)]
   -> GenericPackageDescription)
-> Codec
     Object
     GenericPackageDescription
     [(UnqualComponentName, CondTree ConfVar [Dependency] Library)]
-> Codec
     Object
     GenericPackageDescription
     ([(UnqualComponentName, CondTree ConfVar [Dependency] ForeignLib)]
      -> [(UnqualComponentName,
           CondTree ConfVar [Dependency] Executable)]
      -> [(UnqualComponentName, CondTree ConfVar [Dependency] TestSuite)]
      -> [(UnqualComponentName, CondTree ConfVar [Dependency] Benchmark)]
      -> GenericPackageDescription)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text
-> JSONCodec
     [(UnqualComponentName, CondTree ConfVar [Dependency] Library)]
-> [(UnqualComponentName, CondTree ConfVar [Dependency] Library)]
-> ObjectCodec
     [(UnqualComponentName, CondTree ConfVar [Dependency] Library)]
     [(UnqualComponentName, CondTree ConfVar [Dependency] Library)]
forall output.
Eq output =>
Text -> JSONCodec output -> output -> ObjectCodec output output
optionalFieldWithOmittedDefaultWith' Text
"sublibraries" JSONCodec
  [(UnqualComponentName, CondTree ConfVar [Dependency] Library)]
forall b. HasCodec b => JSONCodec [(UnqualComponentName, b)]
unqualComponentNameCodec [] ObjectCodec
  [(UnqualComponentName, CondTree ConfVar [Dependency] Library)]
  [(UnqualComponentName, CondTree ConfVar [Dependency] Library)]
-> (GenericPackageDescription
    -> [(UnqualComponentName, CondTree ConfVar [Dependency] Library)])
-> Codec
     Object
     GenericPackageDescription
     [(UnqualComponentName, CondTree ConfVar [Dependency] Library)]
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
.= GenericPackageDescription
-> [(UnqualComponentName, CondTree ConfVar [Dependency] Library)]
condSubLibraries
        Codec
  Object
  GenericPackageDescription
  ([(UnqualComponentName, CondTree ConfVar [Dependency] ForeignLib)]
   -> [(UnqualComponentName,
        CondTree ConfVar [Dependency] Executable)]
   -> [(UnqualComponentName, CondTree ConfVar [Dependency] TestSuite)]
   -> [(UnqualComponentName, CondTree ConfVar [Dependency] Benchmark)]
   -> GenericPackageDescription)
-> Codec
     Object
     GenericPackageDescription
     [(UnqualComponentName, CondTree ConfVar [Dependency] ForeignLib)]
-> Codec
     Object
     GenericPackageDescription
     ([(UnqualComponentName, CondTree ConfVar [Dependency] Executable)]
      -> [(UnqualComponentName, CondTree ConfVar [Dependency] TestSuite)]
      -> [(UnqualComponentName, CondTree ConfVar [Dependency] Benchmark)]
      -> GenericPackageDescription)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text
-> JSONCodec
     [(UnqualComponentName, CondTree ConfVar [Dependency] ForeignLib)]
-> [(UnqualComponentName,
     CondTree ConfVar [Dependency] ForeignLib)]
-> ObjectCodec
     [(UnqualComponentName, CondTree ConfVar [Dependency] ForeignLib)]
     [(UnqualComponentName, CondTree ConfVar [Dependency] ForeignLib)]
forall output.
Eq output =>
Text -> JSONCodec output -> output -> ObjectCodec output output
optionalFieldWithOmittedDefaultWith' Text
"foreign-libs" JSONCodec
  [(UnqualComponentName, CondTree ConfVar [Dependency] ForeignLib)]
forall b. HasCodec b => JSONCodec [(UnqualComponentName, b)]
unqualComponentNameCodec [] ObjectCodec
  [(UnqualComponentName, CondTree ConfVar [Dependency] ForeignLib)]
  [(UnqualComponentName, CondTree ConfVar [Dependency] ForeignLib)]
-> (GenericPackageDescription
    -> [(UnqualComponentName,
         CondTree ConfVar [Dependency] ForeignLib)])
-> Codec
     Object
     GenericPackageDescription
     [(UnqualComponentName, CondTree ConfVar [Dependency] ForeignLib)]
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
.= GenericPackageDescription
-> [(UnqualComponentName,
     CondTree ConfVar [Dependency] ForeignLib)]
condForeignLibs
        Codec
  Object
  GenericPackageDescription
  ([(UnqualComponentName, CondTree ConfVar [Dependency] Executable)]
   -> [(UnqualComponentName, CondTree ConfVar [Dependency] TestSuite)]
   -> [(UnqualComponentName, CondTree ConfVar [Dependency] Benchmark)]
   -> GenericPackageDescription)
-> Codec
     Object
     GenericPackageDescription
     [(UnqualComponentName, CondTree ConfVar [Dependency] Executable)]
-> Codec
     Object
     GenericPackageDescription
     ([(UnqualComponentName, CondTree ConfVar [Dependency] TestSuite)]
      -> [(UnqualComponentName, CondTree ConfVar [Dependency] Benchmark)]
      -> GenericPackageDescription)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text
-> JSONCodec
     [(UnqualComponentName, CondTree ConfVar [Dependency] Executable)]
-> [(UnqualComponentName,
     CondTree ConfVar [Dependency] Executable)]
-> ObjectCodec
     [(UnqualComponentName, CondTree ConfVar [Dependency] Executable)]
     [(UnqualComponentName, CondTree ConfVar [Dependency] Executable)]
forall output.
Eq output =>
Text -> JSONCodec output -> output -> ObjectCodec output output
optionalFieldWithOmittedDefaultWith' Text
"executables" JSONCodec
  [(UnqualComponentName, CondTree ConfVar [Dependency] Executable)]
forall b. HasCodec b => JSONCodec [(UnqualComponentName, b)]
unqualComponentNameCodec [] ObjectCodec
  [(UnqualComponentName, CondTree ConfVar [Dependency] Executable)]
  [(UnqualComponentName, CondTree ConfVar [Dependency] Executable)]
-> (GenericPackageDescription
    -> [(UnqualComponentName,
         CondTree ConfVar [Dependency] Executable)])
-> Codec
     Object
     GenericPackageDescription
     [(UnqualComponentName, CondTree ConfVar [Dependency] Executable)]
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
.= GenericPackageDescription
-> [(UnqualComponentName,
     CondTree ConfVar [Dependency] Executable)]
condExecutables
        Codec
  Object
  GenericPackageDescription
  ([(UnqualComponentName, CondTree ConfVar [Dependency] TestSuite)]
   -> [(UnqualComponentName, CondTree ConfVar [Dependency] Benchmark)]
   -> GenericPackageDescription)
-> Codec
     Object
     GenericPackageDescription
     [(UnqualComponentName, CondTree ConfVar [Dependency] TestSuite)]
-> Codec
     Object
     GenericPackageDescription
     ([(UnqualComponentName, CondTree ConfVar [Dependency] Benchmark)]
      -> GenericPackageDescription)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text
-> JSONCodec
     [(UnqualComponentName, CondTree ConfVar [Dependency] TestSuite)]
-> [(UnqualComponentName, CondTree ConfVar [Dependency] TestSuite)]
-> ObjectCodec
     [(UnqualComponentName, CondTree ConfVar [Dependency] TestSuite)]
     [(UnqualComponentName, CondTree ConfVar [Dependency] TestSuite)]
forall output.
Eq output =>
Text -> JSONCodec output -> output -> ObjectCodec output output
optionalFieldWithOmittedDefaultWith' Text
"test-suites" JSONCodec
  [(UnqualComponentName, CondTree ConfVar [Dependency] TestSuite)]
forall b. HasCodec b => JSONCodec [(UnqualComponentName, b)]
unqualComponentNameCodec [] ObjectCodec
  [(UnqualComponentName, CondTree ConfVar [Dependency] TestSuite)]
  [(UnqualComponentName, CondTree ConfVar [Dependency] TestSuite)]
-> (GenericPackageDescription
    -> [(UnqualComponentName,
         CondTree ConfVar [Dependency] TestSuite)])
-> Codec
     Object
     GenericPackageDescription
     [(UnqualComponentName, CondTree ConfVar [Dependency] TestSuite)]
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
.= GenericPackageDescription
-> [(UnqualComponentName, CondTree ConfVar [Dependency] TestSuite)]
condTestSuites
        Codec
  Object
  GenericPackageDescription
  ([(UnqualComponentName, CondTree ConfVar [Dependency] Benchmark)]
   -> GenericPackageDescription)
-> Codec
     Object
     GenericPackageDescription
     [(UnqualComponentName, CondTree ConfVar [Dependency] Benchmark)]
-> ObjectCodec GenericPackageDescription GenericPackageDescription
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text
-> JSONCodec
     [(UnqualComponentName, CondTree ConfVar [Dependency] Benchmark)]
-> [(UnqualComponentName, CondTree ConfVar [Dependency] Benchmark)]
-> ObjectCodec
     [(UnqualComponentName, CondTree ConfVar [Dependency] Benchmark)]
     [(UnqualComponentName, CondTree ConfVar [Dependency] Benchmark)]
forall output.
Eq output =>
Text -> JSONCodec output -> output -> ObjectCodec output output
optionalFieldWithOmittedDefaultWith' Text
"benchmarks" JSONCodec
  [(UnqualComponentName, CondTree ConfVar [Dependency] Benchmark)]
forall b. HasCodec b => JSONCodec [(UnqualComponentName, b)]
unqualComponentNameCodec [] ObjectCodec
  [(UnqualComponentName, CondTree ConfVar [Dependency] Benchmark)]
  [(UnqualComponentName, CondTree ConfVar [Dependency] Benchmark)]
-> (GenericPackageDescription
    -> [(UnqualComponentName,
         CondTree ConfVar [Dependency] Benchmark)])
-> Codec
     Object
     GenericPackageDescription
     [(UnqualComponentName, CondTree ConfVar [Dependency] Benchmark)]
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
.= GenericPackageDescription
-> [(UnqualComponentName, CondTree ConfVar [Dependency] Benchmark)]
condBenchmarks

deriving via (Autodocodec GenericPackageDescription) instance (FromJSON GenericPackageDescription)

deriving via (Autodocodec GenericPackageDescription) instance (ToJSON GenericPackageDescription)

unqualComponentNameCodec :: HasCodec b => JSONCodec [(UnqualComponentName, b)]
unqualComponentNameCodec :: JSONCodec [(UnqualComponentName, b)]
unqualComponentNameCodec = (String -> UnqualComponentName)
-> (UnqualComponentName -> String)
-> JSONCodec [(UnqualComponentName, b)]
forall b a.
HasCodec b =>
(String -> a) -> (a -> String) -> JSONCodec [(a, b)]
mapInListForCodec String -> UnqualComponentName
mkUnqualComponentName UnqualComponentName -> String
unUnqualComponentName

instance HasCodec UnqualComponentName where
  codec :: JSONCodec UnqualComponentName
codec = (String -> UnqualComponentName)
-> (UnqualComponentName -> String)
-> Codec Value String String
-> JSONCodec UnqualComponentName
forall oldOutput newOutput newInput oldInput context.
(oldOutput -> newOutput)
-> (newInput -> oldInput)
-> Codec context oldInput oldOutput
-> Codec context newInput newOutput
dimapCodec String -> UnqualComponentName
mkUnqualComponentName UnqualComponentName -> String
unUnqualComponentName Codec Value String String
forall value. HasCodec value => JSONCodec value
codec

mapInListForCodec ::
  HasCodec b =>
  (String -> a) ->
  (a -> String) ->
  JSONCodec [(a, b)]
mapInListForCodec :: (String -> a) -> (a -> String) -> JSONCodec [(a, b)]
mapInListForCodec String -> a
fromText a -> String
toText =
  (HashMap String b -> [(a, b)])
-> ([(a, b)] -> HashMap String b)
-> Codec Value (HashMap String b) (HashMap String b)
-> JSONCodec [(a, b)]
forall oldOutput newOutput newInput oldInput context.
(oldOutput -> newOutput)
-> (newInput -> oldInput)
-> Codec context oldInput oldOutput
-> Codec context newInput newOutput
dimapCodec
    ([(String, b)] -> [(a, b)]
forall d. [(String, d)] -> [(a, d)]
f ([(String, b)] -> [(a, b)])
-> (HashMap String b -> [(String, b)])
-> HashMap String b
-> [(a, b)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HashMap String b -> [(String, b)]
forall k v. HashMap k v -> [(k, v)]
HM.toList)
    ([(String, b)] -> HashMap String b
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HM.fromList ([(String, b)] -> HashMap String b)
-> ([(a, b)] -> [(String, b)]) -> [(a, b)] -> HashMap String b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(a, b)] -> [(String, b)]
forall d. [(a, d)] -> [(String, d)]
g)
    Codec Value (HashMap String b) (HashMap String b)
forall value. HasCodec value => JSONCodec value
codec
  where
    f :: [(String, d)] -> [(a, d)]
f = ((String, d) -> (a, d)) -> [(String, d)] -> [(a, d)]
forall a b. (a -> b) -> [a] -> [b]
map ((String -> a) -> (String, d) -> (a, d)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first String -> a
fromText)
    g :: [(a, d)] -> [(String, d)]
g = ((a, d) -> (String, d)) -> [(a, d)] -> [(String, d)]
forall a b. (a -> b) -> [a] -> [b]
map ((a -> String) -> (a, d) -> (String, d)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first a -> String
toText)

instance Hashable UnqualComponentName where
  hashWithSalt :: Int -> UnqualComponentName -> Int
hashWithSalt Int
s = Int -> String -> Int
forall a. Hashable a => Int -> a -> Int
hashWithSalt Int
s (String -> Int)
-> (UnqualComponentName -> String) -> UnqualComponentName -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UnqualComponentName -> String
unUnqualComponentName

instance HasCodec VersionRange where
  codec :: JSONCodec VersionRange
codec = (String -> Either String VersionRange)
-> (VersionRange -> String)
-> Codec Value String String
-> JSONCodec VersionRange
forall oldOutput newOutput newInput oldInput context.
(oldOutput -> Either String newOutput)
-> (newInput -> oldInput)
-> Codec context oldInput oldOutput
-> Codec context newInput newOutput
bimapCodec String -> Either String VersionRange
f VersionRange -> String
g Codec Value String String
forall value. HasCodec value => JSONCodec value
codec
    where
      f :: String -> Either String VersionRange
f = \String
s -> case String -> Either String VersionRange
forall a. Parsec a => String -> Either String a
eitherParsec String
s of
        Left String
pe -> String -> Either String VersionRange
forall a b. a -> Either a b
Left (String -> Either String VersionRange)
-> String -> Either String VersionRange
forall a b. (a -> b) -> a -> b
$ String -> String
forall a. Show a => a -> String
show String
pe
        Right VersionRange
a -> VersionRange -> Either String VersionRange
forall a b. b -> Either a b
Right VersionRange
a
      g :: VersionRange -> String
g = VersionRange -> String
forall a. Pretty a => a -> String
prettyShow

instance HasCodec CompilerFlavor where
  codec :: JSONCodec CompilerFlavor
codec =
    NonEmpty (CompilerFlavor, Text) -> JSONCodec CompilerFlavor
forall constant.
Eq constant =>
NonEmpty (constant, Text) -> JSONCodec constant
stringConstCodec
      [ (CompilerFlavor
GHC, Text
"GHC"),
        (CompilerFlavor
GHCJS, Text
"GHCJS"),
        (CompilerFlavor
NHC, Text
"NHC"),
        (CompilerFlavor
YHC, Text
"YHC"),
        (CompilerFlavor
HBC, Text
"HBC"),
        (CompilerFlavor
Helium, Text
"Helium"),
        (CompilerFlavor
JHC, Text
"JHC"),
        (CompilerFlavor
LHC, Text
"LHC"),
        (CompilerFlavor
UHC, Text
"UHC"),
        (CompilerFlavor
Eta, Text
"Eta")
      ]

instance HasCodec PackageDescription where
  codec :: JSONCodec PackageDescription
codec =
    Text
-> ObjectCodec PackageDescription PackageDescription
-> JSONCodec PackageDescription
forall input output.
Text -> ObjectCodec input output -> ValueCodec input output
object Text
"PackageDescription" (ObjectCodec PackageDescription PackageDescription
 -> JSONCodec PackageDescription)
-> ObjectCodec PackageDescription PackageDescription
-> JSONCodec PackageDescription
forall a b. (a -> b) -> a -> b
$
      Either Version VersionRange
-> PackageIdentifier
-> Either License License
-> [String]
-> ShortText
-> ShortText
-> ShortText
-> ShortText
-> [(CompilerFlavor, VersionRange)]
-> ShortText
-> ShortText
-> ShortText
-> [SourceRepo]
-> ShortText
-> ShortText
-> ShortText
-> [(String, String)]
-> Maybe BuildType
-> Maybe SetupBuildInfo
-> Maybe Library
-> [Library]
-> [Executable]
-> [ForeignLib]
-> [TestSuite]
-> [Benchmark]
-> [String]
-> String
-> [String]
-> [String]
-> [String]
-> PackageDescription
PackageDescription
        (Either Version VersionRange
 -> PackageIdentifier
 -> Either License License
 -> [String]
 -> ShortText
 -> ShortText
 -> ShortText
 -> ShortText
 -> [(CompilerFlavor, VersionRange)]
 -> ShortText
 -> ShortText
 -> ShortText
 -> [SourceRepo]
 -> ShortText
 -> ShortText
 -> ShortText
 -> [(String, String)]
 -> Maybe BuildType
 -> Maybe SetupBuildInfo
 -> Maybe Library
 -> [Library]
 -> [Executable]
 -> [ForeignLib]
 -> [TestSuite]
 -> [Benchmark]
 -> [String]
 -> String
 -> [String]
 -> [String]
 -> [String]
 -> PackageDescription)
-> Codec Object PackageDescription (Either Version VersionRange)
-> Codec
     Object
     PackageDescription
     (PackageIdentifier
      -> Either License License
      -> [String]
      -> ShortText
      -> ShortText
      -> ShortText
      -> ShortText
      -> [(CompilerFlavor, VersionRange)]
      -> ShortText
      -> ShortText
      -> ShortText
      -> [SourceRepo]
      -> ShortText
      -> ShortText
      -> ShortText
      -> [(String, String)]
      -> Maybe BuildType
      -> Maybe SetupBuildInfo
      -> Maybe Library
      -> [Library]
      -> [Executable]
      -> [ForeignLib]
      -> [TestSuite]
      -> [Benchmark]
      -> [String]
      -> String
      -> [String]
      -> [String]
      -> [String]
      -> PackageDescription)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text
-> ObjectCodec
     (Either Version VersionRange) (Either Version VersionRange)
forall output. HasCodec output => Text -> ObjectCodec output output
requiredField' Text
"spec-version" ObjectCodec
  (Either Version VersionRange) (Either Version VersionRange)
-> (PackageDescription -> Either Version VersionRange)
-> Codec Object PackageDescription (Either Version VersionRange)
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
.= PackageDescription -> Either Version VersionRange
specVersionRaw
        Codec
  Object
  PackageDescription
  (PackageIdentifier
   -> Either License License
   -> [String]
   -> ShortText
   -> ShortText
   -> ShortText
   -> ShortText
   -> [(CompilerFlavor, VersionRange)]
   -> ShortText
   -> ShortText
   -> ShortText
   -> [SourceRepo]
   -> ShortText
   -> ShortText
   -> ShortText
   -> [(String, String)]
   -> Maybe BuildType
   -> Maybe SetupBuildInfo
   -> Maybe Library
   -> [Library]
   -> [Executable]
   -> [ForeignLib]
   -> [TestSuite]
   -> [Benchmark]
   -> [String]
   -> String
   -> [String]
   -> [String]
   -> [String]
   -> PackageDescription)
-> Codec Object PackageDescription PackageIdentifier
-> Codec
     Object
     PackageDescription
     (Either License License
      -> [String]
      -> ShortText
      -> ShortText
      -> ShortText
      -> ShortText
      -> [(CompilerFlavor, VersionRange)]
      -> ShortText
      -> ShortText
      -> ShortText
      -> [SourceRepo]
      -> ShortText
      -> ShortText
      -> ShortText
      -> [(String, String)]
      -> Maybe BuildType
      -> Maybe SetupBuildInfo
      -> Maybe Library
      -> [Library]
      -> [Executable]
      -> [ForeignLib]
      -> [TestSuite]
      -> [Benchmark]
      -> [String]
      -> String
      -> [String]
      -> [String]
      -> [String]
      -> PackageDescription)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text -> ObjectCodec PackageIdentifier PackageIdentifier
forall output. HasCodec output => Text -> ObjectCodec output output
requiredField' Text
"package" ObjectCodec PackageIdentifier PackageIdentifier
-> (PackageDescription -> PackageIdentifier)
-> Codec Object PackageDescription PackageIdentifier
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
.= PackageDescription -> PackageIdentifier
package
        Codec
  Object
  PackageDescription
  (Either License License
   -> [String]
   -> ShortText
   -> ShortText
   -> ShortText
   -> ShortText
   -> [(CompilerFlavor, VersionRange)]
   -> ShortText
   -> ShortText
   -> ShortText
   -> [SourceRepo]
   -> ShortText
   -> ShortText
   -> ShortText
   -> [(String, String)]
   -> Maybe BuildType
   -> Maybe SetupBuildInfo
   -> Maybe Library
   -> [Library]
   -> [Executable]
   -> [ForeignLib]
   -> [TestSuite]
   -> [Benchmark]
   -> [String]
   -> String
   -> [String]
   -> [String]
   -> [String]
   -> PackageDescription)
-> Codec Object PackageDescription (Either License License)
-> Codec
     Object
     PackageDescription
     ([String]
      -> ShortText
      -> ShortText
      -> ShortText
      -> ShortText
      -> [(CompilerFlavor, VersionRange)]
      -> ShortText
      -> ShortText
      -> ShortText
      -> [SourceRepo]
      -> ShortText
      -> ShortText
      -> ShortText
      -> [(String, String)]
      -> Maybe BuildType
      -> Maybe SetupBuildInfo
      -> Maybe Library
      -> [Library]
      -> [Executable]
      -> [ForeignLib]
      -> [TestSuite]
      -> [Benchmark]
      -> [String]
      -> String
      -> [String]
      -> [String]
      -> [String]
      -> PackageDescription)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text
-> ObjectCodec (Either License License) (Either License License)
forall output. HasCodec output => Text -> ObjectCodec output output
requiredField' Text
"license" ObjectCodec (Either License License) (Either License License)
-> (PackageDescription -> Either License License)
-> Codec Object PackageDescription (Either License License)
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
.= PackageDescription -> Either License License
licenseRaw
        Codec
  Object
  PackageDescription
  ([String]
   -> ShortText
   -> ShortText
   -> ShortText
   -> ShortText
   -> [(CompilerFlavor, VersionRange)]
   -> ShortText
   -> ShortText
   -> ShortText
   -> [SourceRepo]
   -> ShortText
   -> ShortText
   -> ShortText
   -> [(String, String)]
   -> Maybe BuildType
   -> Maybe SetupBuildInfo
   -> Maybe Library
   -> [Library]
   -> [Executable]
   -> [ForeignLib]
   -> [TestSuite]
   -> [Benchmark]
   -> [String]
   -> String
   -> [String]
   -> [String]
   -> [String]
   -> PackageDescription)
-> Codec Object PackageDescription [String]
-> Codec
     Object
     PackageDescription
     (ShortText
      -> ShortText
      -> ShortText
      -> ShortText
      -> [(CompilerFlavor, VersionRange)]
      -> ShortText
      -> ShortText
      -> ShortText
      -> [SourceRepo]
      -> ShortText
      -> ShortText
      -> ShortText
      -> [(String, String)]
      -> Maybe BuildType
      -> Maybe SetupBuildInfo
      -> Maybe Library
      -> [Library]
      -> [Executable]
      -> [ForeignLib]
      -> [TestSuite]
      -> [Benchmark]
      -> [String]
      -> String
      -> [String]
      -> [String]
      -> [String]
      -> PackageDescription)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text -> ObjectCodec [String] [String]
forall output. HasCodec output => Text -> ObjectCodec output output
requiredField' Text
"license-files" ObjectCodec [String] [String]
-> (PackageDescription -> [String])
-> Codec Object PackageDescription [String]
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
.= PackageDescription -> [String]
licenseFiles
        Codec
  Object
  PackageDescription
  (ShortText
   -> ShortText
   -> ShortText
   -> ShortText
   -> [(CompilerFlavor, VersionRange)]
   -> ShortText
   -> ShortText
   -> ShortText
   -> [SourceRepo]
   -> ShortText
   -> ShortText
   -> ShortText
   -> [(String, String)]
   -> Maybe BuildType
   -> Maybe SetupBuildInfo
   -> Maybe Library
   -> [Library]
   -> [Executable]
   -> [ForeignLib]
   -> [TestSuite]
   -> [Benchmark]
   -> [String]
   -> String
   -> [String]
   -> [String]
   -> [String]
   -> PackageDescription)
-> Codec Object PackageDescription ShortText
-> Codec
     Object
     PackageDescription
     (ShortText
      -> ShortText
      -> ShortText
      -> [(CompilerFlavor, VersionRange)]
      -> ShortText
      -> ShortText
      -> ShortText
      -> [SourceRepo]
      -> ShortText
      -> ShortText
      -> ShortText
      -> [(String, String)]
      -> Maybe BuildType
      -> Maybe SetupBuildInfo
      -> Maybe Library
      -> [Library]
      -> [Executable]
      -> [ForeignLib]
      -> [TestSuite]
      -> [Benchmark]
      -> [String]
      -> String
      -> [String]
      -> [String]
      -> [String]
      -> PackageDescription)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text -> ObjectCodec ShortText ShortText
forall output. HasCodec output => Text -> ObjectCodec output output
requiredField' Text
"copyright" ObjectCodec ShortText ShortText
-> (PackageDescription -> ShortText)
-> Codec Object PackageDescription ShortText
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
.= PackageDescription -> ShortText
copyright
        Codec
  Object
  PackageDescription
  (ShortText
   -> ShortText
   -> ShortText
   -> [(CompilerFlavor, VersionRange)]
   -> ShortText
   -> ShortText
   -> ShortText
   -> [SourceRepo]
   -> ShortText
   -> ShortText
   -> ShortText
   -> [(String, String)]
   -> Maybe BuildType
   -> Maybe SetupBuildInfo
   -> Maybe Library
   -> [Library]
   -> [Executable]
   -> [ForeignLib]
   -> [TestSuite]
   -> [Benchmark]
   -> [String]
   -> String
   -> [String]
   -> [String]
   -> [String]
   -> PackageDescription)
-> Codec Object PackageDescription ShortText
-> Codec
     Object
     PackageDescription
     (ShortText
      -> ShortText
      -> [(CompilerFlavor, VersionRange)]
      -> ShortText
      -> ShortText
      -> ShortText
      -> [SourceRepo]
      -> ShortText
      -> ShortText
      -> ShortText
      -> [(String, String)]
      -> Maybe BuildType
      -> Maybe SetupBuildInfo
      -> Maybe Library
      -> [Library]
      -> [Executable]
      -> [ForeignLib]
      -> [TestSuite]
      -> [Benchmark]
      -> [String]
      -> String
      -> [String]
      -> [String]
      -> [String]
      -> PackageDescription)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text -> ObjectCodec ShortText ShortText
forall output. HasCodec output => Text -> ObjectCodec output output
requiredField' Text
"maintainer" ObjectCodec ShortText ShortText
-> (PackageDescription -> ShortText)
-> Codec Object PackageDescription ShortText
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
.= PackageDescription -> ShortText
maintainer
        Codec
  Object
  PackageDescription
  (ShortText
   -> ShortText
   -> [(CompilerFlavor, VersionRange)]
   -> ShortText
   -> ShortText
   -> ShortText
   -> [SourceRepo]
   -> ShortText
   -> ShortText
   -> ShortText
   -> [(String, String)]
   -> Maybe BuildType
   -> Maybe SetupBuildInfo
   -> Maybe Library
   -> [Library]
   -> [Executable]
   -> [ForeignLib]
   -> [TestSuite]
   -> [Benchmark]
   -> [String]
   -> String
   -> [String]
   -> [String]
   -> [String]
   -> PackageDescription)
-> Codec Object PackageDescription ShortText
-> Codec
     Object
     PackageDescription
     (ShortText
      -> [(CompilerFlavor, VersionRange)]
      -> ShortText
      -> ShortText
      -> ShortText
      -> [SourceRepo]
      -> ShortText
      -> ShortText
      -> ShortText
      -> [(String, String)]
      -> Maybe BuildType
      -> Maybe SetupBuildInfo
      -> Maybe Library
      -> [Library]
      -> [Executable]
      -> [ForeignLib]
      -> [TestSuite]
      -> [Benchmark]
      -> [String]
      -> String
      -> [String]
      -> [String]
      -> [String]
      -> PackageDescription)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text -> ObjectCodec ShortText ShortText
forall output. HasCodec output => Text -> ObjectCodec output output
requiredField' Text
"author" ObjectCodec ShortText ShortText
-> (PackageDescription -> ShortText)
-> Codec Object PackageDescription ShortText
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
.= PackageDescription -> ShortText
author
        Codec
  Object
  PackageDescription
  (ShortText
   -> [(CompilerFlavor, VersionRange)]
   -> ShortText
   -> ShortText
   -> ShortText
   -> [SourceRepo]
   -> ShortText
   -> ShortText
   -> ShortText
   -> [(String, String)]
   -> Maybe BuildType
   -> Maybe SetupBuildInfo
   -> Maybe Library
   -> [Library]
   -> [Executable]
   -> [ForeignLib]
   -> [TestSuite]
   -> [Benchmark]
   -> [String]
   -> String
   -> [String]
   -> [String]
   -> [String]
   -> PackageDescription)
-> Codec Object PackageDescription ShortText
-> Codec
     Object
     PackageDescription
     ([(CompilerFlavor, VersionRange)]
      -> ShortText
      -> ShortText
      -> ShortText
      -> [SourceRepo]
      -> ShortText
      -> ShortText
      -> ShortText
      -> [(String, String)]
      -> Maybe BuildType
      -> Maybe SetupBuildInfo
      -> Maybe Library
      -> [Library]
      -> [Executable]
      -> [ForeignLib]
      -> [TestSuite]
      -> [Benchmark]
      -> [String]
      -> String
      -> [String]
      -> [String]
      -> [String]
      -> PackageDescription)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text -> ObjectCodec ShortText ShortText
forall output. HasCodec output => Text -> ObjectCodec output output
requiredField' Text
"stability" ObjectCodec ShortText ShortText
-> (PackageDescription -> ShortText)
-> Codec Object PackageDescription ShortText
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
.= PackageDescription -> ShortText
stability
        Codec
  Object
  PackageDescription
  ([(CompilerFlavor, VersionRange)]
   -> ShortText
   -> ShortText
   -> ShortText
   -> [SourceRepo]
   -> ShortText
   -> ShortText
   -> ShortText
   -> [(String, String)]
   -> Maybe BuildType
   -> Maybe SetupBuildInfo
   -> Maybe Library
   -> [Library]
   -> [Executable]
   -> [ForeignLib]
   -> [TestSuite]
   -> [Benchmark]
   -> [String]
   -> String
   -> [String]
   -> [String]
   -> [String]
   -> PackageDescription)
-> Codec Object PackageDescription [(CompilerFlavor, VersionRange)]
-> Codec
     Object
     PackageDescription
     (ShortText
      -> ShortText
      -> ShortText
      -> [SourceRepo]
      -> ShortText
      -> ShortText
      -> ShortText
      -> [(String, String)]
      -> Maybe BuildType
      -> Maybe SetupBuildInfo
      -> Maybe Library
      -> [Library]
      -> [Executable]
      -> [ForeignLib]
      -> [TestSuite]
      -> [Benchmark]
      -> [String]
      -> String
      -> [String]
      -> [String]
      -> [String]
      -> PackageDescription)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text
-> ObjectCodec
     [(CompilerFlavor, VersionRange)] [(CompilerFlavor, VersionRange)]
forall output. HasCodec output => Text -> ObjectCodec output output
requiredField' Text
"tested-with" ObjectCodec
  [(CompilerFlavor, VersionRange)] [(CompilerFlavor, VersionRange)]
-> (PackageDescription -> [(CompilerFlavor, VersionRange)])
-> Codec Object PackageDescription [(CompilerFlavor, VersionRange)]
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
.= PackageDescription -> [(CompilerFlavor, VersionRange)]
testedWith
        Codec
  Object
  PackageDescription
  (ShortText
   -> ShortText
   -> ShortText
   -> [SourceRepo]
   -> ShortText
   -> ShortText
   -> ShortText
   -> [(String, String)]
   -> Maybe BuildType
   -> Maybe SetupBuildInfo
   -> Maybe Library
   -> [Library]
   -> [Executable]
   -> [ForeignLib]
   -> [TestSuite]
   -> [Benchmark]
   -> [String]
   -> String
   -> [String]
   -> [String]
   -> [String]
   -> PackageDescription)
-> Codec Object PackageDescription ShortText
-> Codec
     Object
     PackageDescription
     (ShortText
      -> ShortText
      -> [SourceRepo]
      -> ShortText
      -> ShortText
      -> ShortText
      -> [(String, String)]
      -> Maybe BuildType
      -> Maybe SetupBuildInfo
      -> Maybe Library
      -> [Library]
      -> [Executable]
      -> [ForeignLib]
      -> [TestSuite]
      -> [Benchmark]
      -> [String]
      -> String
      -> [String]
      -> [String]
      -> [String]
      -> PackageDescription)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text -> ObjectCodec ShortText ShortText
forall output. HasCodec output => Text -> ObjectCodec output output
requiredField' Text
"homepage" ObjectCodec ShortText ShortText
-> (PackageDescription -> ShortText)
-> Codec Object PackageDescription ShortText
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
.= PackageDescription -> ShortText
homepage
        Codec
  Object
  PackageDescription
  (ShortText
   -> ShortText
   -> [SourceRepo]
   -> ShortText
   -> ShortText
   -> ShortText
   -> [(String, String)]
   -> Maybe BuildType
   -> Maybe SetupBuildInfo
   -> Maybe Library
   -> [Library]
   -> [Executable]
   -> [ForeignLib]
   -> [TestSuite]
   -> [Benchmark]
   -> [String]
   -> String
   -> [String]
   -> [String]
   -> [String]
   -> PackageDescription)
-> Codec Object PackageDescription ShortText
-> Codec
     Object
     PackageDescription
     (ShortText
      -> [SourceRepo]
      -> ShortText
      -> ShortText
      -> ShortText
      -> [(String, String)]
      -> Maybe BuildType
      -> Maybe SetupBuildInfo
      -> Maybe Library
      -> [Library]
      -> [Executable]
      -> [ForeignLib]
      -> [TestSuite]
      -> [Benchmark]
      -> [String]
      -> String
      -> [String]
      -> [String]
      -> [String]
      -> PackageDescription)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text -> ObjectCodec ShortText ShortText
forall output. HasCodec output => Text -> ObjectCodec output output
requiredField' Text
"pkg-url" ObjectCodec ShortText ShortText
-> (PackageDescription -> ShortText)
-> Codec Object PackageDescription ShortText
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
.= PackageDescription -> ShortText
pkgUrl
        Codec
  Object
  PackageDescription
  (ShortText
   -> [SourceRepo]
   -> ShortText
   -> ShortText
   -> ShortText
   -> [(String, String)]
   -> Maybe BuildType
   -> Maybe SetupBuildInfo
   -> Maybe Library
   -> [Library]
   -> [Executable]
   -> [ForeignLib]
   -> [TestSuite]
   -> [Benchmark]
   -> [String]
   -> String
   -> [String]
   -> [String]
   -> [String]
   -> PackageDescription)
-> Codec Object PackageDescription ShortText
-> Codec
     Object
     PackageDescription
     ([SourceRepo]
      -> ShortText
      -> ShortText
      -> ShortText
      -> [(String, String)]
      -> Maybe BuildType
      -> Maybe SetupBuildInfo
      -> Maybe Library
      -> [Library]
      -> [Executable]
      -> [ForeignLib]
      -> [TestSuite]
      -> [Benchmark]
      -> [String]
      -> String
      -> [String]
      -> [String]
      -> [String]
      -> PackageDescription)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text -> ObjectCodec ShortText ShortText
forall output. HasCodec output => Text -> ObjectCodec output output
requiredField' Text
"bug-reports" ObjectCodec ShortText ShortText
-> (PackageDescription -> ShortText)
-> Codec Object PackageDescription ShortText
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
.= PackageDescription -> ShortText
bugReports
        Codec
  Object
  PackageDescription
  ([SourceRepo]
   -> ShortText
   -> ShortText
   -> ShortText
   -> [(String, String)]
   -> Maybe BuildType
   -> Maybe SetupBuildInfo
   -> Maybe Library
   -> [Library]
   -> [Executable]
   -> [ForeignLib]
   -> [TestSuite]
   -> [Benchmark]
   -> [String]
   -> String
   -> [String]
   -> [String]
   -> [String]
   -> PackageDescription)
-> Codec Object PackageDescription [SourceRepo]
-> Codec
     Object
     PackageDescription
     (ShortText
      -> ShortText
      -> ShortText
      -> [(String, String)]
      -> Maybe BuildType
      -> Maybe SetupBuildInfo
      -> Maybe Library
      -> [Library]
      -> [Executable]
      -> [ForeignLib]
      -> [TestSuite]
      -> [Benchmark]
      -> [String]
      -> String
      -> [String]
      -> [String]
      -> [String]
      -> PackageDescription)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text -> ObjectCodec [SourceRepo] [SourceRepo]
forall output. HasCodec output => Text -> ObjectCodec output output
requiredField' Text
"source-repos" ObjectCodec [SourceRepo] [SourceRepo]
-> (PackageDescription -> [SourceRepo])
-> Codec Object PackageDescription [SourceRepo]
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
.= PackageDescription -> [SourceRepo]
sourceRepos
        Codec
  Object
  PackageDescription
  (ShortText
   -> ShortText
   -> ShortText
   -> [(String, String)]
   -> Maybe BuildType
   -> Maybe SetupBuildInfo
   -> Maybe Library
   -> [Library]
   -> [Executable]
   -> [ForeignLib]
   -> [TestSuite]
   -> [Benchmark]
   -> [String]
   -> String
   -> [String]
   -> [String]
   -> [String]
   -> PackageDescription)
-> Codec Object PackageDescription ShortText
-> Codec
     Object
     PackageDescription
     (ShortText
      -> ShortText
      -> [(String, String)]
      -> Maybe BuildType
      -> Maybe SetupBuildInfo
      -> Maybe Library
      -> [Library]
      -> [Executable]
      -> [ForeignLib]
      -> [TestSuite]
      -> [Benchmark]
      -> [String]
      -> String
      -> [String]
      -> [String]
      -> [String]
      -> PackageDescription)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text -> ObjectCodec ShortText ShortText
forall output. HasCodec output => Text -> ObjectCodec output output
requiredField' Text
"synopsis" ObjectCodec ShortText ShortText
-> (PackageDescription -> ShortText)
-> Codec Object PackageDescription ShortText
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
.= PackageDescription -> ShortText
synopsis
        Codec
  Object
  PackageDescription
  (ShortText
   -> ShortText
   -> [(String, String)]
   -> Maybe BuildType
   -> Maybe SetupBuildInfo
   -> Maybe Library
   -> [Library]
   -> [Executable]
   -> [ForeignLib]
   -> [TestSuite]
   -> [Benchmark]
   -> [String]
   -> String
   -> [String]
   -> [String]
   -> [String]
   -> PackageDescription)
-> Codec Object PackageDescription ShortText
-> Codec
     Object
     PackageDescription
     (ShortText
      -> [(String, String)]
      -> Maybe BuildType
      -> Maybe SetupBuildInfo
      -> Maybe Library
      -> [Library]
      -> [Executable]
      -> [ForeignLib]
      -> [TestSuite]
      -> [Benchmark]
      -> [String]
      -> String
      -> [String]
      -> [String]
      -> [String]
      -> PackageDescription)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text -> ObjectCodec ShortText ShortText
forall output. HasCodec output => Text -> ObjectCodec output output
requiredField' Text
"description" ObjectCodec ShortText ShortText
-> (PackageDescription -> ShortText)
-> Codec Object PackageDescription ShortText
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
.= PackageDescription -> ShortText
description
        Codec
  Object
  PackageDescription
  (ShortText
   -> [(String, String)]
   -> Maybe BuildType
   -> Maybe SetupBuildInfo
   -> Maybe Library
   -> [Library]
   -> [Executable]
   -> [ForeignLib]
   -> [TestSuite]
   -> [Benchmark]
   -> [String]
   -> String
   -> [String]
   -> [String]
   -> [String]
   -> PackageDescription)
-> Codec Object PackageDescription ShortText
-> Codec
     Object
     PackageDescription
     ([(String, String)]
      -> Maybe BuildType
      -> Maybe SetupBuildInfo
      -> Maybe Library
      -> [Library]
      -> [Executable]
      -> [ForeignLib]
      -> [TestSuite]
      -> [Benchmark]
      -> [String]
      -> String
      -> [String]
      -> [String]
      -> [String]
      -> PackageDescription)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text -> ObjectCodec ShortText ShortText
forall output. HasCodec output => Text -> ObjectCodec output output
requiredField' Text
"category" ObjectCodec ShortText ShortText
-> (PackageDescription -> ShortText)
-> Codec Object PackageDescription ShortText
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
.= PackageDescription -> ShortText
category
        Codec
  Object
  PackageDescription
  ([(String, String)]
   -> Maybe BuildType
   -> Maybe SetupBuildInfo
   -> Maybe Library
   -> [Library]
   -> [Executable]
   -> [ForeignLib]
   -> [TestSuite]
   -> [Benchmark]
   -> [String]
   -> String
   -> [String]
   -> [String]
   -> [String]
   -> PackageDescription)
-> Codec Object PackageDescription [(String, String)]
-> Codec
     Object
     PackageDescription
     (Maybe BuildType
      -> Maybe SetupBuildInfo
      -> Maybe Library
      -> [Library]
      -> [Executable]
      -> [ForeignLib]
      -> [TestSuite]
      -> [Benchmark]
      -> [String]
      -> String
      -> [String]
      -> [String]
      -> [String]
      -> PackageDescription)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text -> ObjectCodec [(String, String)] [(String, String)]
forall output. HasCodec output => Text -> ObjectCodec output output
requiredField' Text
"custom-fields" ObjectCodec [(String, String)] [(String, String)]
-> (PackageDescription -> [(String, String)])
-> Codec Object PackageDescription [(String, String)]
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
.= PackageDescription -> [(String, String)]
customFieldsPD
        Codec
  Object
  PackageDescription
  (Maybe BuildType
   -> Maybe SetupBuildInfo
   -> Maybe Library
   -> [Library]
   -> [Executable]
   -> [ForeignLib]
   -> [TestSuite]
   -> [Benchmark]
   -> [String]
   -> String
   -> [String]
   -> [String]
   -> [String]
   -> PackageDescription)
-> Codec Object PackageDescription (Maybe BuildType)
-> Codec
     Object
     PackageDescription
     (Maybe SetupBuildInfo
      -> Maybe Library
      -> [Library]
      -> [Executable]
      -> [ForeignLib]
      -> [TestSuite]
      -> [Benchmark]
      -> [String]
      -> String
      -> [String]
      -> [String]
      -> [String]
      -> PackageDescription)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text -> ObjectCodec (Maybe BuildType) (Maybe BuildType)
forall output. HasCodec output => Text -> ObjectCodec output output
requiredField' Text
"build-type-raw" ObjectCodec (Maybe BuildType) (Maybe BuildType)
-> (PackageDescription -> Maybe BuildType)
-> Codec Object PackageDescription (Maybe BuildType)
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
.= PackageDescription -> Maybe BuildType
buildTypeRaw
        Codec
  Object
  PackageDescription
  (Maybe SetupBuildInfo
   -> Maybe Library
   -> [Library]
   -> [Executable]
   -> [ForeignLib]
   -> [TestSuite]
   -> [Benchmark]
   -> [String]
   -> String
   -> [String]
   -> [String]
   -> [String]
   -> PackageDescription)
-> Codec Object PackageDescription (Maybe SetupBuildInfo)
-> Codec
     Object
     PackageDescription
     (Maybe Library
      -> [Library]
      -> [Executable]
      -> [ForeignLib]
      -> [TestSuite]
      -> [Benchmark]
      -> [String]
      -> String
      -> [String]
      -> [String]
      -> [String]
      -> PackageDescription)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text -> ObjectCodec (Maybe SetupBuildInfo) (Maybe SetupBuildInfo)
forall output. HasCodec output => Text -> ObjectCodec output output
requiredField' Text
"custom-setup" ObjectCodec (Maybe SetupBuildInfo) (Maybe SetupBuildInfo)
-> (PackageDescription -> Maybe SetupBuildInfo)
-> Codec Object PackageDescription (Maybe SetupBuildInfo)
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
.= PackageDescription -> Maybe SetupBuildInfo
setupBuildInfo
        Codec
  Object
  PackageDescription
  (Maybe Library
   -> [Library]
   -> [Executable]
   -> [ForeignLib]
   -> [TestSuite]
   -> [Benchmark]
   -> [String]
   -> String
   -> [String]
   -> [String]
   -> [String]
   -> PackageDescription)
-> Codec Object PackageDescription (Maybe Library)
-> Codec
     Object
     PackageDescription
     ([Library]
      -> [Executable]
      -> [ForeignLib]
      -> [TestSuite]
      -> [Benchmark]
      -> [String]
      -> String
      -> [String]
      -> [String]
      -> [String]
      -> PackageDescription)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text -> ObjectCodec (Maybe Library) (Maybe Library)
forall output. HasCodec output => Text -> ObjectCodec output output
requiredField' Text
"library" ObjectCodec (Maybe Library) (Maybe Library)
-> (PackageDescription -> Maybe Library)
-> Codec Object PackageDescription (Maybe Library)
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
.= PackageDescription -> Maybe Library
library
        Codec
  Object
  PackageDescription
  ([Library]
   -> [Executable]
   -> [ForeignLib]
   -> [TestSuite]
   -> [Benchmark]
   -> [String]
   -> String
   -> [String]
   -> [String]
   -> [String]
   -> PackageDescription)
-> Codec Object PackageDescription [Library]
-> Codec
     Object
     PackageDescription
     ([Executable]
      -> [ForeignLib]
      -> [TestSuite]
      -> [Benchmark]
      -> [String]
      -> String
      -> [String]
      -> [String]
      -> [String]
      -> PackageDescription)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text -> ObjectCodec [Library] [Library]
forall output. HasCodec output => Text -> ObjectCodec output output
requiredField' Text
"sublibraries" ObjectCodec [Library] [Library]
-> (PackageDescription -> [Library])
-> Codec Object PackageDescription [Library]
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
.= PackageDescription -> [Library]
subLibraries
        Codec
  Object
  PackageDescription
  ([Executable]
   -> [ForeignLib]
   -> [TestSuite]
   -> [Benchmark]
   -> [String]
   -> String
   -> [String]
   -> [String]
   -> [String]
   -> PackageDescription)
-> Codec Object PackageDescription [Executable]
-> Codec
     Object
     PackageDescription
     ([ForeignLib]
      -> [TestSuite]
      -> [Benchmark]
      -> [String]
      -> String
      -> [String]
      -> [String]
      -> [String]
      -> PackageDescription)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text -> ObjectCodec [Executable] [Executable]
forall output. HasCodec output => Text -> ObjectCodec output output
requiredField' Text
"executables" ObjectCodec [Executable] [Executable]
-> (PackageDescription -> [Executable])
-> Codec Object PackageDescription [Executable]
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
.= PackageDescription -> [Executable]
executables
        Codec
  Object
  PackageDescription
  ([ForeignLib]
   -> [TestSuite]
   -> [Benchmark]
   -> [String]
   -> String
   -> [String]
   -> [String]
   -> [String]
   -> PackageDescription)
-> Codec Object PackageDescription [ForeignLib]
-> Codec
     Object
     PackageDescription
     ([TestSuite]
      -> [Benchmark]
      -> [String]
      -> String
      -> [String]
      -> [String]
      -> [String]
      -> PackageDescription)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text -> ObjectCodec [ForeignLib] [ForeignLib]
forall output. HasCodec output => Text -> ObjectCodec output output
requiredField' Text
"foreign-libs" ObjectCodec [ForeignLib] [ForeignLib]
-> (PackageDescription -> [ForeignLib])
-> Codec Object PackageDescription [ForeignLib]
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
.= PackageDescription -> [ForeignLib]
foreignLibs
        Codec
  Object
  PackageDescription
  ([TestSuite]
   -> [Benchmark]
   -> [String]
   -> String
   -> [String]
   -> [String]
   -> [String]
   -> PackageDescription)
-> Codec Object PackageDescription [TestSuite]
-> Codec
     Object
     PackageDescription
     ([Benchmark]
      -> [String]
      -> String
      -> [String]
      -> [String]
      -> [String]
      -> PackageDescription)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text -> ObjectCodec [TestSuite] [TestSuite]
forall output. HasCodec output => Text -> ObjectCodec output output
requiredField' Text
"test-suites" ObjectCodec [TestSuite] [TestSuite]
-> (PackageDescription -> [TestSuite])
-> Codec Object PackageDescription [TestSuite]
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
.= PackageDescription -> [TestSuite]
testSuites
        Codec
  Object
  PackageDescription
  ([Benchmark]
   -> [String]
   -> String
   -> [String]
   -> [String]
   -> [String]
   -> PackageDescription)
-> Codec Object PackageDescription [Benchmark]
-> Codec
     Object
     PackageDescription
     ([String]
      -> String
      -> [String]
      -> [String]
      -> [String]
      -> PackageDescription)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text -> ObjectCodec [Benchmark] [Benchmark]
forall output. HasCodec output => Text -> ObjectCodec output output
requiredField' Text
"benchmarks" ObjectCodec [Benchmark] [Benchmark]
-> (PackageDescription -> [Benchmark])
-> Codec Object PackageDescription [Benchmark]
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
.= PackageDescription -> [Benchmark]
benchmarks
        Codec
  Object
  PackageDescription
  ([String]
   -> String
   -> [String]
   -> [String]
   -> [String]
   -> PackageDescription)
-> Codec Object PackageDescription [String]
-> Codec
     Object
     PackageDescription
     (String -> [String] -> [String] -> [String] -> PackageDescription)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text -> ObjectCodec [String] [String]
forall output. HasCodec output => Text -> ObjectCodec output output
requiredField' Text
"data-files" ObjectCodec [String] [String]
-> (PackageDescription -> [String])
-> Codec Object PackageDescription [String]
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
.= PackageDescription -> [String]
dataFiles
        Codec
  Object
  PackageDescription
  (String -> [String] -> [String] -> [String] -> PackageDescription)
-> Codec Object PackageDescription String
-> Codec
     Object
     PackageDescription
     ([String] -> [String] -> [String] -> PackageDescription)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text -> ObjectCodec String String
forall output. HasCodec output => Text -> ObjectCodec output output
requiredField' Text
"data-dir" ObjectCodec String String
-> (PackageDescription -> String)
-> Codec Object PackageDescription String
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
.= PackageDescription -> String
dataDir
        Codec
  Object
  PackageDescription
  ([String] -> [String] -> [String] -> PackageDescription)
-> Codec Object PackageDescription [String]
-> Codec
     Object
     PackageDescription
     ([String] -> [String] -> PackageDescription)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text -> ObjectCodec [String] [String]
forall output. HasCodec output => Text -> ObjectCodec output output
requiredField' Text
"extra-source-files" ObjectCodec [String] [String]
-> (PackageDescription -> [String])
-> Codec Object PackageDescription [String]
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
.= PackageDescription -> [String]
extraSrcFiles
        Codec
  Object
  PackageDescription
  ([String] -> [String] -> PackageDescription)
-> Codec Object PackageDescription [String]
-> Codec Object PackageDescription ([String] -> PackageDescription)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text -> ObjectCodec [String] [String]
forall output. HasCodec output => Text -> ObjectCodec output output
requiredField' Text
"extra-tmp-files" ObjectCodec [String] [String]
-> (PackageDescription -> [String])
-> Codec Object PackageDescription [String]
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
.= PackageDescription -> [String]
extraTmpFiles
        Codec Object PackageDescription ([String] -> PackageDescription)
-> Codec Object PackageDescription [String]
-> ObjectCodec PackageDescription PackageDescription
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text -> ObjectCodec [String] [String]
forall output. HasCodec output => Text -> ObjectCodec output output
requiredField' Text
"extra-doc-files" ObjectCodec [String] [String]
-> (PackageDescription -> [String])
-> Codec Object PackageDescription [String]
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
.= PackageDescription -> [String]
extraDocFiles

instance HasCodec (PerCompilerFlavor [String]) where
  codec :: JSONCodec (PerCompilerFlavor [String])
codec = (([String], [String]) -> PerCompilerFlavor [String])
-> (PerCompilerFlavor [String] -> ([String], [String]))
-> Codec Value ([String], [String]) ([String], [String])
-> JSONCodec (PerCompilerFlavor [String])
forall oldOutput newOutput newInput oldInput context.
(oldOutput -> newOutput)
-> (newInput -> oldInput)
-> Codec context oldInput oldOutput
-> Codec context newInput newOutput
dimapCodec (([String] -> [String] -> PerCompilerFlavor [String])
-> ([String], [String]) -> PerCompilerFlavor [String]
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry [String] -> [String] -> PerCompilerFlavor [String]
forall v. v -> v -> PerCompilerFlavor v
PerCompilerFlavor) (\(PerCompilerFlavor [String]
a [String]
b) -> ([String]
a, [String]
b)) Codec Value ([String], [String]) ([String], [String])
forall value. HasCodec value => JSONCodec value
codec

instance (HasCodec a) => HasCodec (a, a) where
  codec :: JSONCodec (a, a)
codec = ([a] -> (a, a))
-> ((a, a) -> [a]) -> Codec Value [a] [a] -> JSONCodec (a, a)
forall oldOutput newOutput newInput oldInput context.
(oldOutput -> newOutput)
-> (newInput -> oldInput)
-> Codec context oldInput oldOutput
-> Codec context newInput newOutput
dimapCodec (\(a
a : [Item [a]
b]) -> (a
a, a
Item [a]
b)) (\(a
a, a
b) -> [a
Item [a]
a, a
Item [a]
b]) Codec Value [a] [a]
forall value. HasCodec value => JSONCodec value
codec

instance HasCodec (CompilerFlavor, VersionRange) where
  codec :: JSONCodec (CompilerFlavor, VersionRange)
codec =
    Text
-> ObjectCodec
     (CompilerFlavor, VersionRange) (CompilerFlavor, VersionRange)
-> JSONCodec (CompilerFlavor, VersionRange)
forall input output.
Text -> ObjectCodec input output -> ValueCodec input output
object Text
"(CompilerFlavor, VersionRange)" (ObjectCodec
   (CompilerFlavor, VersionRange) (CompilerFlavor, VersionRange)
 -> JSONCodec (CompilerFlavor, VersionRange))
-> ObjectCodec
     (CompilerFlavor, VersionRange) (CompilerFlavor, VersionRange)
-> JSONCodec (CompilerFlavor, VersionRange)
forall a b. (a -> b) -> a -> b
$
      (,)
        (CompilerFlavor -> VersionRange -> (CompilerFlavor, VersionRange))
-> Codec Object (CompilerFlavor, VersionRange) CompilerFlavor
-> Codec
     Object
     (CompilerFlavor, VersionRange)
     (VersionRange -> (CompilerFlavor, VersionRange))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> ObjectCodec CompilerFlavor CompilerFlavor
forall output. HasCodec output => Text -> ObjectCodec output output
requiredField' Text
"compiler" ObjectCodec CompilerFlavor CompilerFlavor
-> ((CompilerFlavor, VersionRange) -> CompilerFlavor)
-> Codec Object (CompilerFlavor, VersionRange) CompilerFlavor
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
.= (CompilerFlavor, VersionRange) -> CompilerFlavor
forall a b. (a, b) -> a
fst
        Codec
  Object
  (CompilerFlavor, VersionRange)
  (VersionRange -> (CompilerFlavor, VersionRange))
-> Codec Object (CompilerFlavor, VersionRange) VersionRange
-> ObjectCodec
     (CompilerFlavor, VersionRange) (CompilerFlavor, VersionRange)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text -> ObjectCodec VersionRange VersionRange
forall output. HasCodec output => Text -> ObjectCodec output output
requiredField' Text
"versionRange" ObjectCodec VersionRange VersionRange
-> ((CompilerFlavor, VersionRange) -> VersionRange)
-> Codec Object (CompilerFlavor, VersionRange) VersionRange
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
.= (CompilerFlavor, VersionRange) -> VersionRange
forall a b. (a, b) -> b
snd

instance (HasCodec a) => HasCodec (a, a, a) where
  codec :: JSONCodec (a, a, a)
codec = ([a] -> (a, a, a))
-> ((a, a, a) -> [a]) -> Codec Value [a] [a] -> JSONCodec (a, a, a)
forall oldOutput newOutput newInput oldInput context.
(oldOutput -> newOutput)
-> (newInput -> oldInput)
-> Codec context oldInput oldOutput
-> Codec context newInput newOutput
dimapCodec (\(a
a : a
b : [Item [a]
c]) -> (a
a, a
b, a
Item [a]
c)) (\(a
a, a
b, a
c) -> [a
Item [a]
a, a
Item [a]
b, a
Item [a]
c]) Codec Value [a] [a]
forall value. HasCodec value => JSONCodec value
codec

instance HasCodec (Maybe String, String) where
  codec :: JSONCodec (Maybe String, String)
codec =
    ((String, String) -> (Maybe String, String))
-> ((Maybe String, String) -> (String, String))
-> Codec Value (String, String) (String, String)
-> JSONCodec (Maybe String, String)
forall oldOutput newOutput newInput oldInput context.
(oldOutput -> newOutput)
-> (newInput -> oldInput)
-> Codec context oldInput oldOutput
-> Codec context newInput newOutput
dimapCodec
      ( \case
          (String
"", String
s) -> (Maybe String
forall a. Maybe a
Nothing, String
s)
          (String
s1, String
s2) -> (String -> Maybe String
forall a. a -> Maybe a
Just String
s1, String
s2)
      )
      ( \case
          (Maybe String
Nothing, String
s) -> (String
"", String
s)
          (Just String
s1, String
s2) -> (String
s1, String
s2)
      )
      Codec Value (String, String) (String, String)
forall value. HasCodec value => JSONCodec value
codec

instance HasCodec PackageName where
  codec :: JSONCodec PackageName
codec = (String -> PackageName)
-> (PackageName -> String)
-> Codec Value String String
-> JSONCodec PackageName
forall oldOutput newOutput newInput oldInput context.
(oldOutput -> newOutput)
-> (newInput -> oldInput)
-> Codec context oldInput oldOutput
-> Codec context newInput newOutput
dimapCodec String -> PackageName
mkPackageName PackageName -> String
unPackageName Codec Value String String
forall value. HasCodec value => JSONCodec value
codec

instance HasCodec PackageIdentifier where
  codec :: JSONCodec PackageIdentifier
codec =
    Text
-> ObjectCodec PackageIdentifier PackageIdentifier
-> JSONCodec PackageIdentifier
forall input output.
Text -> ObjectCodec input output -> ValueCodec input output
object Text
"PackgeIdentifier" (ObjectCodec PackageIdentifier PackageIdentifier
 -> JSONCodec PackageIdentifier)
-> ObjectCodec PackageIdentifier PackageIdentifier
-> JSONCodec PackageIdentifier
forall a b. (a -> b) -> a -> b
$
      PackageName -> Version -> PackageIdentifier
PackageIdentifier
        (PackageName -> Version -> PackageIdentifier)
-> Codec Object PackageIdentifier PackageName
-> Codec Object PackageIdentifier (Version -> PackageIdentifier)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> ObjectCodec PackageName PackageName
forall output. HasCodec output => Text -> ObjectCodec output output
requiredField' Text
"name" ObjectCodec PackageName PackageName
-> (PackageIdentifier -> PackageName)
-> Codec Object PackageIdentifier PackageName
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
.= PackageIdentifier -> PackageName
pkgName
        Codec Object PackageIdentifier (Version -> PackageIdentifier)
-> Codec Object PackageIdentifier Version
-> ObjectCodec PackageIdentifier PackageIdentifier
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text -> ObjectCodec Version Version
forall output. HasCodec output => Text -> ObjectCodec output output
requiredField' Text
"version" ObjectCodec Version Version
-> (PackageIdentifier -> Version)
-> Codec Object PackageIdentifier Version
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
.= PackageIdentifier -> Version
pkgVersion

instance HasCodec RepoKind where
  codec :: JSONCodec RepoKind
codec =
    Text -> ObjectCodec RepoKind RepoKind -> JSONCodec RepoKind
forall input output.
Text -> ObjectCodec input output -> ValueCodec input output
object Text
"RepoKind" (ObjectCodec RepoKind RepoKind -> JSONCodec RepoKind)
-> ObjectCodec RepoKind RepoKind -> JSONCodec RepoKind
forall a b. (a -> b) -> a -> b
$
      (Either RepoKind (Either RepoKind String) -> RepoKind)
-> (RepoKind -> Either () (Either () String))
-> Codec
     Object
     (Either () (Either () String))
     (Either RepoKind (Either RepoKind String))
-> ObjectCodec RepoKind RepoKind
forall oldOutput newOutput newInput oldInput context.
(oldOutput -> newOutput)
-> (newInput -> oldInput)
-> Codec context oldInput oldOutput
-> Codec context newInput newOutput
dimapCodec Either RepoKind (Either RepoKind String) -> RepoKind
forall a a. Either a (Either a String) -> RepoKind
f RepoKind -> Either () (Either () String)
g (Codec
   Object
   (Either () (Either () String))
   (Either RepoKind (Either RepoKind String))
 -> ObjectCodec RepoKind RepoKind)
-> Codec
     Object
     (Either () (Either () String))
     (Either RepoKind (Either RepoKind String))
-> ObjectCodec RepoKind RepoKind
forall a b. (a -> b) -> a -> b
$
        Codec Object () RepoKind
-> Codec Object (Either () String) (Either RepoKind String)
-> Codec
     Object
     (Either () (Either () String))
     (Either RepoKind (Either RepoKind String))
forall context input1 output1 input2 output2.
Codec context input1 output1
-> Codec context input2 output2
-> Codec context (Either input1 input2) (Either output1 output2)
eitherCodec (RepoKind -> Codec Object () RepoKind
forall (f :: * -> *) a. Applicative f => a -> f a
pure RepoKind
RepoHead) (Codec Object (Either () String) (Either RepoKind String)
 -> Codec
      Object
      (Either () (Either () String))
      (Either RepoKind (Either RepoKind String)))
-> Codec Object (Either () String) (Either RepoKind String)
-> Codec
     Object
     (Either () (Either () String))
     (Either RepoKind (Either RepoKind String))
forall a b. (a -> b) -> a -> b
$
          Codec Object () RepoKind
-> ObjectCodec String String
-> Codec Object (Either () String) (Either RepoKind String)
forall context input1 output1 input2 output2.
Codec context input1 output1
-> Codec context input2 output2
-> Codec context (Either input1 input2) (Either output1 output2)
eitherCodec (RepoKind -> Codec Object () RepoKind
forall (f :: * -> *) a. Applicative f => a -> f a
pure RepoKind
RepoThis) (ObjectCodec String String
 -> Codec Object (Either () String) (Either RepoKind String))
-> ObjectCodec String String
-> Codec Object (Either () String) (Either RepoKind String)
forall a b. (a -> b) -> a -> b
$
            Text -> ObjectCodec String String
forall output. HasCodec output => Text -> ObjectCodec output output
requiredField' Text
"repo-kind"
    where
      f :: Either a (Either a String) -> RepoKind
f = \case
        Left a
_ -> RepoKind
RepoHead
        Right (Left a
_) -> RepoKind
RepoThis
        Right (Right String
s) -> String -> RepoKind
RepoKindUnknown String
s
      g :: RepoKind -> Either () (Either () String)
g = \case
        RepoKind
RepoHead -> () -> Either () (Either () String)
forall a b. a -> Either a b
Left ()
        RepoKind
RepoThis -> Either () String -> Either () (Either () String)
forall a b. b -> Either a b
Right (Either () String -> Either () (Either () String))
-> Either () String -> Either () (Either () String)
forall a b. (a -> b) -> a -> b
$ () -> Either () String
forall a b. a -> Either a b
Left ()
        RepoKindUnknown String
s -> Either () String -> Either () (Either () String)
forall a b. b -> Either a b
Right (Either () String -> Either () (Either () String))
-> Either () String -> Either () (Either () String)
forall a b. (a -> b) -> a -> b
$ String -> Either () String
forall a b. b -> Either a b
Right String
s

instance HasCodec RepoType where
  -- TODO add OtherRepoType
  codec :: JSONCodec RepoType
codec =
    NonEmpty (RepoType, Text) -> JSONCodec RepoType
forall constant.
Eq constant =>
NonEmpty (constant, Text) -> JSONCodec constant
stringConstCodec
      [ (RepoType
Darcs, Text
"Darcs"),
        (RepoType
Git, Text
"Git"),
        (RepoType
SVN, Text
"SVN"),
        (RepoType
CVS, Text
"CVS"),
        (RepoType
Mercurial, Text
"Mercurial"),
        (RepoType
GnuArch, Text
"GnuArch"),
        (RepoType
Bazaar, Text
"Bazaar"),
        (RepoType
Monotone, Text
"Monotone")
      ]

instance HasCodec Dependency where
  codec :: JSONCodec Dependency
codec =
    Text -> ObjectCodec Dependency Dependency -> JSONCodec Dependency
forall input output.
Text -> ObjectCodec input output -> ValueCodec input output
object Text
"Dependency" (ObjectCodec Dependency Dependency -> JSONCodec Dependency)
-> ObjectCodec Dependency Dependency -> JSONCodec Dependency
forall a b. (a -> b) -> a -> b
$
      PackageName -> VersionRange -> Set LibraryName -> Dependency
Dependency
        (PackageName -> VersionRange -> Set LibraryName -> Dependency)
-> Codec Object Dependency PackageName
-> Codec
     Object Dependency (VersionRange -> Set LibraryName -> Dependency)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> ObjectCodec PackageName PackageName
forall output. HasCodec output => Text -> ObjectCodec output output
requiredField' Text
"package-name" ObjectCodec PackageName PackageName
-> (Dependency -> PackageName)
-> Codec Object Dependency PackageName
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
.= (\(Dependency PackageName
name VersionRange
_ Set LibraryName
_) -> PackageName
name)
        Codec
  Object Dependency (VersionRange -> Set LibraryName -> Dependency)
-> Codec Object Dependency VersionRange
-> Codec Object Dependency (Set LibraryName -> Dependency)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text -> ObjectCodec VersionRange VersionRange
forall output. HasCodec output => Text -> ObjectCodec output output
requiredField' Text
"version-range" ObjectCodec VersionRange VersionRange
-> (Dependency -> VersionRange)
-> Codec Object Dependency VersionRange
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
.= (\(Dependency PackageName
_ VersionRange
version Set LibraryName
_) -> VersionRange
version)
        Codec Object Dependency (Set LibraryName -> Dependency)
-> Codec Object Dependency (Set LibraryName)
-> ObjectCodec Dependency Dependency
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text -> ObjectCodec (Set LibraryName) (Set LibraryName)
forall output. HasCodec output => Text -> ObjectCodec output output
requiredField' Text
"library" ObjectCodec (Set LibraryName) (Set LibraryName)
-> (Dependency -> Set LibraryName)
-> Codec Object Dependency (Set LibraryName)
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
.= (\(Dependency PackageName
_ VersionRange
_ Set LibraryName
lib) -> Set LibraryName
lib)

instance HasCodec SourceRepo where
  codec :: JSONCodec SourceRepo
codec =
    Text -> ObjectCodec SourceRepo SourceRepo -> JSONCodec SourceRepo
forall input output.
Text -> ObjectCodec input output -> ValueCodec input output
object Text
"SourceRepo" (ObjectCodec SourceRepo SourceRepo -> JSONCodec SourceRepo)
-> ObjectCodec SourceRepo SourceRepo -> JSONCodec SourceRepo
forall a b. (a -> b) -> a -> b
$
      RepoKind
-> Maybe RepoType
-> Maybe String
-> Maybe String
-> Maybe String
-> Maybe String
-> Maybe String
-> SourceRepo
SourceRepo
        (RepoKind
 -> Maybe RepoType
 -> Maybe String
 -> Maybe String
 -> Maybe String
 -> Maybe String
 -> Maybe String
 -> SourceRepo)
-> Codec Object SourceRepo RepoKind
-> Codec
     Object
     SourceRepo
     (Maybe RepoType
      -> Maybe String
      -> Maybe String
      -> Maybe String
      -> Maybe String
      -> Maybe String
      -> SourceRepo)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> ObjectCodec RepoKind RepoKind
forall output. HasCodec output => Text -> ObjectCodec output output
requiredField' Text
"kind" ObjectCodec RepoKind RepoKind
-> (SourceRepo -> RepoKind) -> Codec Object SourceRepo RepoKind
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
.= SourceRepo -> RepoKind
repoKind
        Codec
  Object
  SourceRepo
  (Maybe RepoType
   -> Maybe String
   -> Maybe String
   -> Maybe String
   -> Maybe String
   -> Maybe String
   -> SourceRepo)
-> Codec Object SourceRepo (Maybe RepoType)
-> Codec
     Object
     SourceRepo
     (Maybe String
      -> Maybe String
      -> Maybe String
      -> Maybe String
      -> Maybe String
      -> SourceRepo)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text -> ObjectCodec (Maybe RepoType) (Maybe RepoType)
forall output. HasCodec output => Text -> ObjectCodec output output
requiredField' Text
"type" ObjectCodec (Maybe RepoType) (Maybe RepoType)
-> (SourceRepo -> Maybe RepoType)
-> Codec Object SourceRepo (Maybe RepoType)
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
.= SourceRepo -> Maybe RepoType
repoType
        Codec
  Object
  SourceRepo
  (Maybe String
   -> Maybe String
   -> Maybe String
   -> Maybe String
   -> Maybe String
   -> SourceRepo)
-> Codec Object SourceRepo (Maybe String)
-> Codec
     Object
     SourceRepo
     (Maybe String
      -> Maybe String -> Maybe String -> Maybe String -> SourceRepo)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text -> ObjectCodec (Maybe String) (Maybe String)
forall output. HasCodec output => Text -> ObjectCodec output output
requiredField' Text
"location" ObjectCodec (Maybe String) (Maybe String)
-> (SourceRepo -> Maybe String)
-> Codec Object SourceRepo (Maybe String)
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
.= SourceRepo -> Maybe String
repoLocation
        Codec
  Object
  SourceRepo
  (Maybe String
   -> Maybe String -> Maybe String -> Maybe String -> SourceRepo)
-> Codec Object SourceRepo (Maybe String)
-> Codec
     Object
     SourceRepo
     (Maybe String -> Maybe String -> Maybe String -> SourceRepo)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text -> ObjectCodec (Maybe String) (Maybe String)
forall output. HasCodec output => Text -> ObjectCodec output output
requiredField' Text
"module" ObjectCodec (Maybe String) (Maybe String)
-> (SourceRepo -> Maybe String)
-> Codec Object SourceRepo (Maybe String)
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
.= SourceRepo -> Maybe String
repoModule
        Codec
  Object
  SourceRepo
  (Maybe String -> Maybe String -> Maybe String -> SourceRepo)
-> Codec Object SourceRepo (Maybe String)
-> Codec
     Object SourceRepo (Maybe String -> Maybe String -> SourceRepo)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text -> ObjectCodec (Maybe String) (Maybe String)
forall output. HasCodec output => Text -> ObjectCodec output output
requiredField' Text
"branch" ObjectCodec (Maybe String) (Maybe String)
-> (SourceRepo -> Maybe String)
-> Codec Object SourceRepo (Maybe String)
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
.= SourceRepo -> Maybe String
repoBranch
        Codec
  Object SourceRepo (Maybe String -> Maybe String -> SourceRepo)
-> Codec Object SourceRepo (Maybe String)
-> Codec Object SourceRepo (Maybe String -> SourceRepo)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text -> ObjectCodec (Maybe String) (Maybe String)
forall output. HasCodec output => Text -> ObjectCodec output output
requiredField' Text
"tag" ObjectCodec (Maybe String) (Maybe String)
-> (SourceRepo -> Maybe String)
-> Codec Object SourceRepo (Maybe String)
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
.= SourceRepo -> Maybe String
repoTag
        Codec Object SourceRepo (Maybe String -> SourceRepo)
-> Codec Object SourceRepo (Maybe String)
-> ObjectCodec SourceRepo SourceRepo
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text -> ObjectCodec (Maybe String) (Maybe String)
forall output. HasCodec output => Text -> ObjectCodec output output
requiredField' Text
"subdir" ObjectCodec (Maybe String) (Maybe String)
-> (SourceRepo -> Maybe String)
-> Codec Object SourceRepo (Maybe String)
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
.= SourceRepo -> Maybe String
repoSubdir

instance HasCodec ShortText where
  codec :: JSONCodec ShortText
codec = (String -> ShortText)
-> (ShortText -> String)
-> Codec Value String String
-> JSONCodec ShortText
forall oldOutput newOutput newInput oldInput context.
(oldOutput -> newOutput)
-> (newInput -> oldInput)
-> Codec context oldInput oldOutput
-> Codec context newInput newOutput
dimapCodec String -> ShortText
toShortText ShortText -> String
fromShortText Codec Value String String
forall value. HasCodec value => JSONCodec value
codec

instance HasCodec Cabal.License where
  -- TODO add others
  codec :: JSONCodec License
codec =
    Text -> JSONCodec License -> JSONCodec License
forall input output.
Text -> ValueCodec input output -> ValueCodec input output
named Text
"Cabal.License" (JSONCodec License -> JSONCodec License)
-> JSONCodec License -> JSONCodec License
forall a b. (a -> b) -> a -> b
$
      NonEmpty (License, Text) -> JSONCodec License
forall constant.
Eq constant =>
NonEmpty (constant, Text) -> JSONCodec constant
stringConstCodec
        [ (License
BSD2, Text
"BSD2"),
          (License
BSD3, Text
"BSD3"),
          (License
BSD4, Text
"BSD4"),
          (License
MIT, Text
"MIT"),
          (License
ISC, Text
"ISC"),
          (License
PublicDomain, Text
"PublicDomain"),
          (License
AllRightsReserved, Text
"AllRightsReserved"),
          (License
UnspecifiedLicense, Text
"UnspecifiedLicense"),
          (License
OtherLicense, Text
"OtherLicense")
        ]

instance HasCodec SPDX.License where
  codec :: JSONCodec License
codec =
    Text -> JSONCodec License -> JSONCodec License
forall input output.
Text -> ValueCodec input output -> ValueCodec input output
named Text
"SPDX.License" (JSONCodec License -> JSONCodec License)
-> JSONCodec License -> JSONCodec License
forall a b. (a -> b) -> a -> b
$
      Text -> ObjectCodec License License -> JSONCodec License
forall input output.
Text -> ObjectCodec input output -> ValueCodec input output
object Text
"spdx-license" (ObjectCodec License License -> JSONCodec License)
-> ObjectCodec License License -> JSONCodec License
forall a b. (a -> b) -> a -> b
$
        (Either License LicenseExpression -> License)
-> (License -> Either String LicenseExpression)
-> Codec
     Object
     (Either String LicenseExpression)
     (Either License LicenseExpression)
-> ObjectCodec License License
forall oldOutput newOutput newInput oldInput context.
(oldOutput -> newOutput)
-> (newInput -> oldInput)
-> Codec context oldInput oldOutput
-> Codec context newInput newOutput
dimapCodec Either License LicenseExpression -> License
forall a. Either a LicenseExpression -> License
f License -> Either String LicenseExpression
g (Codec
   Object
   (Either String LicenseExpression)
   (Either License LicenseExpression)
 -> ObjectCodec License License)
-> Codec
     Object
     (Either String LicenseExpression)
     (Either License LicenseExpression)
-> ObjectCodec License License
forall a b. (a -> b) -> a -> b
$
          Codec Object String License
-> Codec Object LicenseExpression LicenseExpression
-> Codec
     Object
     (Either String LicenseExpression)
     (Either License LicenseExpression)
forall context input1 output1 input2 output2.
Codec context input1 output1
-> Codec context input2 output2
-> Codec context (Either input1 input2) (Either output1 output2)
eitherCodec (License -> Codec Object String License
forall (f :: * -> *) a. Applicative f => a -> f a
pure License
NONE) (Codec Object LicenseExpression LicenseExpression
 -> Codec
      Object
      (Either String LicenseExpression)
      (Either License LicenseExpression))
-> Codec Object LicenseExpression LicenseExpression
-> Codec
     Object
     (Either String LicenseExpression)
     (Either License LicenseExpression)
forall a b. (a -> b) -> a -> b
$
            Text -> Codec Object LicenseExpression LicenseExpression
forall output. HasCodec output => Text -> ObjectCodec output output
requiredField' Text
"license-expression"
    where
      f :: Either a LicenseExpression -> License
f = \case
        Left a
_ -> License
NONE
        Right LicenseExpression
e -> LicenseExpression -> License
License LicenseExpression
e
      g :: License -> Either String LicenseExpression
g = \case
        License
NONE -> String -> Either String LicenseExpression
forall a b. a -> Either a b
Left (String
"None" :: String)
        License LicenseExpression
e -> LicenseExpression -> Either String LicenseExpression
forall a b. b -> Either a b
Right LicenseExpression
e

instance HasCodec SPDX.LicenseExpression where
  codec :: JSONCodec LicenseExpression
codec =
    Text -> JSONCodec LicenseExpression -> JSONCodec LicenseExpression
forall input output.
Text -> ValueCodec input output -> ValueCodec input output
named Text
"LicenseExpression" (JSONCodec LicenseExpression -> JSONCodec LicenseExpression)
-> JSONCodec LicenseExpression -> JSONCodec LicenseExpression
forall a b. (a -> b) -> a -> b
$
      (Either
   (SimpleLicenseExpression, Maybe LicenseExceptionId)
   (Either
      (LicenseExpression, LicenseExpression)
      (LicenseExpression, LicenseExpression))
 -> LicenseExpression)
-> (LicenseExpression
    -> Either
         (SimpleLicenseExpression, Maybe LicenseExceptionId)
         (Either
            (LicenseExpression, LicenseExpression)
            (LicenseExpression, LicenseExpression)))
-> Codec
     Value
     (Either
        (SimpleLicenseExpression, Maybe LicenseExceptionId)
        (Either
           (LicenseExpression, LicenseExpression)
           (LicenseExpression, LicenseExpression)))
     (Either
        (SimpleLicenseExpression, Maybe LicenseExceptionId)
        (Either
           (LicenseExpression, LicenseExpression)
           (LicenseExpression, LicenseExpression)))
-> JSONCodec LicenseExpression
forall oldOutput newOutput newInput oldInput context.
(oldOutput -> newOutput)
-> (newInput -> oldInput)
-> Codec context oldInput oldOutput
-> Codec context newInput newOutput
dimapCodec Either
  (SimpleLicenseExpression, Maybe LicenseExceptionId)
  (Either
     (LicenseExpression, LicenseExpression)
     (LicenseExpression, LicenseExpression))
-> LicenseExpression
f LicenseExpression
-> Either
     (SimpleLicenseExpression, Maybe LicenseExceptionId)
     (Either
        (LicenseExpression, LicenseExpression)
        (LicenseExpression, LicenseExpression))
g (Codec
   Value
   (Either
      (SimpleLicenseExpression, Maybe LicenseExceptionId)
      (Either
         (LicenseExpression, LicenseExpression)
         (LicenseExpression, LicenseExpression)))
   (Either
      (SimpleLicenseExpression, Maybe LicenseExceptionId)
      (Either
         (LicenseExpression, LicenseExpression)
         (LicenseExpression, LicenseExpression)))
 -> JSONCodec LicenseExpression)
-> Codec
     Value
     (Either
        (SimpleLicenseExpression, Maybe LicenseExceptionId)
        (Either
           (LicenseExpression, LicenseExpression)
           (LicenseExpression, LicenseExpression)))
     (Either
        (SimpleLicenseExpression, Maybe LicenseExceptionId)
        (Either
           (LicenseExpression, LicenseExpression)
           (LicenseExpression, LicenseExpression)))
-> JSONCodec LicenseExpression
forall a b. (a -> b) -> a -> b
$
        Codec
  Value
  (SimpleLicenseExpression, Maybe LicenseExceptionId)
  (SimpleLicenseExpression, Maybe LicenseExceptionId)
-> Codec
     Value
     (Either
        (LicenseExpression, LicenseExpression)
        (LicenseExpression, LicenseExpression))
     (Either
        (LicenseExpression, LicenseExpression)
        (LicenseExpression, LicenseExpression))
-> Codec
     Value
     (Either
        (SimpleLicenseExpression, Maybe LicenseExceptionId)
        (Either
           (LicenseExpression, LicenseExpression)
           (LicenseExpression, LicenseExpression)))
     (Either
        (SimpleLicenseExpression, Maybe LicenseExceptionId)
        (Either
           (LicenseExpression, LicenseExpression)
           (LicenseExpression, LicenseExpression)))
forall context input1 output1 input2 output2.
Codec context input1 output1
-> Codec context input2 output2
-> Codec context (Either input1 input2) (Either output1 output2)
eitherCodec (Text
-> ObjectCodec
     (SimpleLicenseExpression, Maybe LicenseExceptionId)
     (SimpleLicenseExpression, Maybe LicenseExceptionId)
-> Codec
     Value
     (SimpleLicenseExpression, Maybe LicenseExceptionId)
     (SimpleLicenseExpression, Maybe LicenseExceptionId)
forall input output.
Text -> ObjectCodec input output -> ValueCodec input output
object Text
"ELicense" (ObjectCodec
   (SimpleLicenseExpression, Maybe LicenseExceptionId)
   (SimpleLicenseExpression, Maybe LicenseExceptionId)
 -> Codec
      Value
      (SimpleLicenseExpression, Maybe LicenseExceptionId)
      (SimpleLicenseExpression, Maybe LicenseExceptionId))
-> ObjectCodec
     (SimpleLicenseExpression, Maybe LicenseExceptionId)
     (SimpleLicenseExpression, Maybe LicenseExceptionId)
-> Codec
     Value
     (SimpleLicenseExpression, Maybe LicenseExceptionId)
     (SimpleLicenseExpression, Maybe LicenseExceptionId)
forall a b. (a -> b) -> a -> b
$ (,) (SimpleLicenseExpression
 -> Maybe LicenseExceptionId
 -> (SimpleLicenseExpression, Maybe LicenseExceptionId))
-> Codec
     Object
     (SimpleLicenseExpression, Maybe LicenseExceptionId)
     SimpleLicenseExpression
-> Codec
     Object
     (SimpleLicenseExpression, Maybe LicenseExceptionId)
     (Maybe LicenseExceptionId
      -> (SimpleLicenseExpression, Maybe LicenseExceptionId))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> ObjectCodec SimpleLicenseExpression SimpleLicenseExpression
forall output. HasCodec output => Text -> ObjectCodec output output
requiredField' Text
"expression" ObjectCodec SimpleLicenseExpression SimpleLicenseExpression
-> ((SimpleLicenseExpression, Maybe LicenseExceptionId)
    -> SimpleLicenseExpression)
-> Codec
     Object
     (SimpleLicenseExpression, Maybe LicenseExceptionId)
     SimpleLicenseExpression
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
.= (SimpleLicenseExpression, Maybe LicenseExceptionId)
-> SimpleLicenseExpression
forall a b. (a, b) -> a
fst Codec
  Object
  (SimpleLicenseExpression, Maybe LicenseExceptionId)
  (Maybe LicenseExceptionId
   -> (SimpleLicenseExpression, Maybe LicenseExceptionId))
-> Codec
     Object
     (SimpleLicenseExpression, Maybe LicenseExceptionId)
     (Maybe LicenseExceptionId)
-> ObjectCodec
     (SimpleLicenseExpression, Maybe LicenseExceptionId)
     (SimpleLicenseExpression, Maybe LicenseExceptionId)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text
-> ObjectCodec
     (Maybe LicenseExceptionId) (Maybe LicenseExceptionId)
forall output. HasCodec output => Text -> ObjectCodec output output
requiredField' Text
"exception-id" ObjectCodec (Maybe LicenseExceptionId) (Maybe LicenseExceptionId)
-> ((SimpleLicenseExpression, Maybe LicenseExceptionId)
    -> Maybe LicenseExceptionId)
-> Codec
     Object
     (SimpleLicenseExpression, Maybe LicenseExceptionId)
     (Maybe LicenseExceptionId)
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
.= (SimpleLicenseExpression, Maybe LicenseExceptionId)
-> Maybe LicenseExceptionId
forall a b. (a, b) -> b
snd) (Codec
   Value
   (Either
      (LicenseExpression, LicenseExpression)
      (LicenseExpression, LicenseExpression))
   (Either
      (LicenseExpression, LicenseExpression)
      (LicenseExpression, LicenseExpression))
 -> Codec
      Value
      (Either
         (SimpleLicenseExpression, Maybe LicenseExceptionId)
         (Either
            (LicenseExpression, LicenseExpression)
            (LicenseExpression, LicenseExpression)))
      (Either
         (SimpleLicenseExpression, Maybe LicenseExceptionId)
         (Either
            (LicenseExpression, LicenseExpression)
            (LicenseExpression, LicenseExpression))))
-> Codec
     Value
     (Either
        (LicenseExpression, LicenseExpression)
        (LicenseExpression, LicenseExpression))
     (Either
        (LicenseExpression, LicenseExpression)
        (LicenseExpression, LicenseExpression))
-> Codec
     Value
     (Either
        (SimpleLicenseExpression, Maybe LicenseExceptionId)
        (Either
           (LicenseExpression, LicenseExpression)
           (LicenseExpression, LicenseExpression)))
     (Either
        (SimpleLicenseExpression, Maybe LicenseExceptionId)
        (Either
           (LicenseExpression, LicenseExpression)
           (LicenseExpression, LicenseExpression)))
forall a b. (a -> b) -> a -> b
$
          Codec
  Value
  (LicenseExpression, LicenseExpression)
  (LicenseExpression, LicenseExpression)
-> Codec
     Value
     (LicenseExpression, LicenseExpression)
     (LicenseExpression, LicenseExpression)
-> Codec
     Value
     (Either
        (LicenseExpression, LicenseExpression)
        (LicenseExpression, LicenseExpression))
     (Either
        (LicenseExpression, LicenseExpression)
        (LicenseExpression, LicenseExpression))
forall context input1 output1 input2 output2.
Codec context input1 output1
-> Codec context input2 output2
-> Codec context (Either input1 input2) (Either output1 output2)
eitherCodec (Text
-> ObjectCodec
     (LicenseExpression, LicenseExpression)
     (LicenseExpression, LicenseExpression)
-> Codec
     Value
     (LicenseExpression, LicenseExpression)
     (LicenseExpression, LicenseExpression)
forall input output.
Text -> ObjectCodec input output -> ValueCodec input output
object Text
"EAnd" (ObjectCodec
   (LicenseExpression, LicenseExpression)
   (LicenseExpression, LicenseExpression)
 -> Codec
      Value
      (LicenseExpression, LicenseExpression)
      (LicenseExpression, LicenseExpression))
-> ObjectCodec
     (LicenseExpression, LicenseExpression)
     (LicenseExpression, LicenseExpression)
-> Codec
     Value
     (LicenseExpression, LicenseExpression)
     (LicenseExpression, LicenseExpression)
forall a b. (a -> b) -> a -> b
$ (,) (LicenseExpression
 -> LicenseExpression -> (LicenseExpression, LicenseExpression))
-> Codec
     Object (LicenseExpression, LicenseExpression) LicenseExpression
-> Codec
     Object
     (LicenseExpression, LicenseExpression)
     (LicenseExpression -> (LicenseExpression, LicenseExpression))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Codec Object LicenseExpression LicenseExpression
forall output. HasCodec output => Text -> ObjectCodec output output
requiredField' Text
"expression-1" Codec Object LicenseExpression LicenseExpression
-> ((LicenseExpression, LicenseExpression) -> LicenseExpression)
-> Codec
     Object (LicenseExpression, LicenseExpression) LicenseExpression
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
.= (LicenseExpression, LicenseExpression) -> LicenseExpression
forall a b. (a, b) -> a
fst Codec
  Object
  (LicenseExpression, LicenseExpression)
  (LicenseExpression -> (LicenseExpression, LicenseExpression))
-> Codec
     Object (LicenseExpression, LicenseExpression) LicenseExpression
-> ObjectCodec
     (LicenseExpression, LicenseExpression)
     (LicenseExpression, LicenseExpression)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text -> Codec Object LicenseExpression LicenseExpression
forall output. HasCodec output => Text -> ObjectCodec output output
requiredField' Text
"expression-2" Codec Object LicenseExpression LicenseExpression
-> ((LicenseExpression, LicenseExpression) -> LicenseExpression)
-> Codec
     Object (LicenseExpression, LicenseExpression) LicenseExpression
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
.= (LicenseExpression, LicenseExpression) -> LicenseExpression
forall a b. (a, b) -> b
snd) (Codec
   Value
   (LicenseExpression, LicenseExpression)
   (LicenseExpression, LicenseExpression)
 -> Codec
      Value
      (Either
         (LicenseExpression, LicenseExpression)
         (LicenseExpression, LicenseExpression))
      (Either
         (LicenseExpression, LicenseExpression)
         (LicenseExpression, LicenseExpression)))
-> Codec
     Value
     (LicenseExpression, LicenseExpression)
     (LicenseExpression, LicenseExpression)
-> Codec
     Value
     (Either
        (LicenseExpression, LicenseExpression)
        (LicenseExpression, LicenseExpression))
     (Either
        (LicenseExpression, LicenseExpression)
        (LicenseExpression, LicenseExpression))
forall a b. (a -> b) -> a -> b
$
            Text
-> ObjectCodec
     (LicenseExpression, LicenseExpression)
     (LicenseExpression, LicenseExpression)
-> Codec
     Value
     (LicenseExpression, LicenseExpression)
     (LicenseExpression, LicenseExpression)
forall input output.
Text -> ObjectCodec input output -> ValueCodec input output
object Text
"EOr" (ObjectCodec
   (LicenseExpression, LicenseExpression)
   (LicenseExpression, LicenseExpression)
 -> Codec
      Value
      (LicenseExpression, LicenseExpression)
      (LicenseExpression, LicenseExpression))
-> ObjectCodec
     (LicenseExpression, LicenseExpression)
     (LicenseExpression, LicenseExpression)
-> Codec
     Value
     (LicenseExpression, LicenseExpression)
     (LicenseExpression, LicenseExpression)
forall a b. (a -> b) -> a -> b
$ (,) (LicenseExpression
 -> LicenseExpression -> (LicenseExpression, LicenseExpression))
-> Codec
     Object (LicenseExpression, LicenseExpression) LicenseExpression
-> Codec
     Object
     (LicenseExpression, LicenseExpression)
     (LicenseExpression -> (LicenseExpression, LicenseExpression))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Codec Object LicenseExpression LicenseExpression
forall output. HasCodec output => Text -> ObjectCodec output output
requiredField' Text
"expression-11" Codec Object LicenseExpression LicenseExpression
-> ((LicenseExpression, LicenseExpression) -> LicenseExpression)
-> Codec
     Object (LicenseExpression, LicenseExpression) LicenseExpression
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
.= (LicenseExpression, LicenseExpression) -> LicenseExpression
forall a b. (a, b) -> a
fst Codec
  Object
  (LicenseExpression, LicenseExpression)
  (LicenseExpression -> (LicenseExpression, LicenseExpression))
-> Codec
     Object (LicenseExpression, LicenseExpression) LicenseExpression
-> ObjectCodec
     (LicenseExpression, LicenseExpression)
     (LicenseExpression, LicenseExpression)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text -> Codec Object LicenseExpression LicenseExpression
forall output. HasCodec output => Text -> ObjectCodec output output
requiredField' Text
"expression-22" Codec Object LicenseExpression LicenseExpression
-> ((LicenseExpression, LicenseExpression) -> LicenseExpression)
-> Codec
     Object (LicenseExpression, LicenseExpression) LicenseExpression
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
.= (LicenseExpression, LicenseExpression) -> LicenseExpression
forall a b. (a, b) -> b
snd
    where
      f :: Either
  (SimpleLicenseExpression, Maybe LicenseExceptionId)
  (Either
     (LicenseExpression, LicenseExpression)
     (LicenseExpression, LicenseExpression))
-> LicenseExpression
f = \case
        Left (SimpleLicenseExpression
e, Maybe LicenseExceptionId
c) -> SimpleLicenseExpression
-> Maybe LicenseExceptionId -> LicenseExpression
ELicense SimpleLicenseExpression
e Maybe LicenseExceptionId
c
        Right (Left (LicenseExpression
exp1, LicenseExpression
exp2)) -> LicenseExpression -> LicenseExpression -> LicenseExpression
EAnd LicenseExpression
exp1 LicenseExpression
exp2
        Right (Right (LicenseExpression
exp1, LicenseExpression
exp2)) -> LicenseExpression -> LicenseExpression -> LicenseExpression
EOr LicenseExpression
exp1 LicenseExpression
exp2
      g :: LicenseExpression
-> Either
     (SimpleLicenseExpression, Maybe LicenseExceptionId)
     (Either
        (LicenseExpression, LicenseExpression)
        (LicenseExpression, LicenseExpression))
g = \case
        ELicense SimpleLicenseExpression
e Maybe LicenseExceptionId
c -> (SimpleLicenseExpression, Maybe LicenseExceptionId)
-> Either
     (SimpleLicenseExpression, Maybe LicenseExceptionId)
     (Either
        (LicenseExpression, LicenseExpression)
        (LicenseExpression, LicenseExpression))
forall a b. a -> Either a b
Left (SimpleLicenseExpression
e, Maybe LicenseExceptionId
c)
        EAnd LicenseExpression
exp1 LicenseExpression
exp2 -> Either
  (LicenseExpression, LicenseExpression)
  (LicenseExpression, LicenseExpression)
-> Either
     (SimpleLicenseExpression, Maybe LicenseExceptionId)
     (Either
        (LicenseExpression, LicenseExpression)
        (LicenseExpression, LicenseExpression))
forall a b. b -> Either a b
Right (Either
   (LicenseExpression, LicenseExpression)
   (LicenseExpression, LicenseExpression)
 -> Either
      (SimpleLicenseExpression, Maybe LicenseExceptionId)
      (Either
         (LicenseExpression, LicenseExpression)
         (LicenseExpression, LicenseExpression)))
-> Either
     (LicenseExpression, LicenseExpression)
     (LicenseExpression, LicenseExpression)
-> Either
     (SimpleLicenseExpression, Maybe LicenseExceptionId)
     (Either
        (LicenseExpression, LicenseExpression)
        (LicenseExpression, LicenseExpression))
forall a b. (a -> b) -> a -> b
$ (LicenseExpression, LicenseExpression)
-> Either
     (LicenseExpression, LicenseExpression)
     (LicenseExpression, LicenseExpression)
forall a b. a -> Either a b
Left (LicenseExpression
exp1, LicenseExpression
exp2)
        EOr LicenseExpression
exp1 LicenseExpression
exp2 -> Either
  (LicenseExpression, LicenseExpression)
  (LicenseExpression, LicenseExpression)
-> Either
     (SimpleLicenseExpression, Maybe LicenseExceptionId)
     (Either
        (LicenseExpression, LicenseExpression)
        (LicenseExpression, LicenseExpression))
forall a b. b -> Either a b
Right (Either
   (LicenseExpression, LicenseExpression)
   (LicenseExpression, LicenseExpression)
 -> Either
      (SimpleLicenseExpression, Maybe LicenseExceptionId)
      (Either
         (LicenseExpression, LicenseExpression)
         (LicenseExpression, LicenseExpression)))
-> Either
     (LicenseExpression, LicenseExpression)
     (LicenseExpression, LicenseExpression)
-> Either
     (SimpleLicenseExpression, Maybe LicenseExceptionId)
     (Either
        (LicenseExpression, LicenseExpression)
        (LicenseExpression, LicenseExpression))
forall a b. (a -> b) -> a -> b
$ (LicenseExpression, LicenseExpression)
-> Either
     (LicenseExpression, LicenseExpression)
     (LicenseExpression, LicenseExpression)
forall a b. b -> Either a b
Right (LicenseExpression
exp1, LicenseExpression
exp2)

instance HasCodec SPDX.SimpleLicenseExpression where
  codec :: JSONCodec SimpleLicenseExpression
codec =
    Text
-> ObjectCodec SimpleLicenseExpression SimpleLicenseExpression
-> JSONCodec SimpleLicenseExpression
forall input output.
Text -> ObjectCodec input output -> ValueCodec input output
object Text
"SimpleLicenseExpression" (ObjectCodec SimpleLicenseExpression SimpleLicenseExpression
 -> JSONCodec SimpleLicenseExpression)
-> ObjectCodec SimpleLicenseExpression SimpleLicenseExpression
-> JSONCodec SimpleLicenseExpression
forall a b. (a -> b) -> a -> b
$
      (Either LicenseId (Either LicenseId LicenseRef)
 -> SimpleLicenseExpression)
-> (SimpleLicenseExpression
    -> Either LicenseId (Either LicenseId LicenseRef))
-> Codec
     Object
     (Either LicenseId (Either LicenseId LicenseRef))
     (Either LicenseId (Either LicenseId LicenseRef))
-> ObjectCodec SimpleLicenseExpression SimpleLicenseExpression
forall oldOutput newOutput newInput oldInput context.
(oldOutput -> newOutput)
-> (newInput -> oldInput)
-> Codec context oldInput oldOutput
-> Codec context newInput newOutput
dimapCodec Either LicenseId (Either LicenseId LicenseRef)
-> SimpleLicenseExpression
f SimpleLicenseExpression
-> Either LicenseId (Either LicenseId LicenseRef)
g (Codec
   Object
   (Either LicenseId (Either LicenseId LicenseRef))
   (Either LicenseId (Either LicenseId LicenseRef))
 -> ObjectCodec SimpleLicenseExpression SimpleLicenseExpression)
-> Codec
     Object
     (Either LicenseId (Either LicenseId LicenseRef))
     (Either LicenseId (Either LicenseId LicenseRef))
-> ObjectCodec SimpleLicenseExpression SimpleLicenseExpression
forall a b. (a -> b) -> a -> b
$
        Codec Object LicenseId LicenseId
-> Codec
     Object (Either LicenseId LicenseRef) (Either LicenseId LicenseRef)
-> Codec
     Object
     (Either LicenseId (Either LicenseId LicenseRef))
     (Either LicenseId (Either LicenseId LicenseRef))
forall context input1 output1 input2 output2.
Codec context input1 output1
-> Codec context input2 output2
-> Codec context (Either input1 input2) (Either output1 output2)
eitherCodec (Text -> Codec Object LicenseId LicenseId
forall output. HasCodec output => Text -> ObjectCodec output output
requiredField' Text
"id") (Codec
   Object (Either LicenseId LicenseRef) (Either LicenseId LicenseRef)
 -> Codec
      Object
      (Either LicenseId (Either LicenseId LicenseRef))
      (Either LicenseId (Either LicenseId LicenseRef)))
-> Codec
     Object (Either LicenseId LicenseRef) (Either LicenseId LicenseRef)
-> Codec
     Object
     (Either LicenseId (Either LicenseId LicenseRef))
     (Either LicenseId (Either LicenseId LicenseRef))
forall a b. (a -> b) -> a -> b
$
          Codec Object LicenseId LicenseId
-> Codec Object LicenseRef LicenseRef
-> Codec
     Object (Either LicenseId LicenseRef) (Either LicenseId LicenseRef)
forall context input1 output1 input2 output2.
Codec context input1 output1
-> Codec context input2 output2
-> Codec context (Either input1 input2) (Either output1 output2)
eitherCodec (Text -> Codec Object LicenseId LicenseId
forall output. HasCodec output => Text -> ObjectCodec output output
requiredField' Text
"id-plus") (Codec Object LicenseRef LicenseRef
 -> Codec
      Object (Either LicenseId LicenseRef) (Either LicenseId LicenseRef))
-> Codec Object LicenseRef LicenseRef
-> Codec
     Object (Either LicenseId LicenseRef) (Either LicenseId LicenseRef)
forall a b. (a -> b) -> a -> b
$
            Text -> Codec Object LicenseRef LicenseRef
forall output. HasCodec output => Text -> ObjectCodec output output
requiredField' Text
"license-ref"
    where
      f :: Either LicenseId (Either LicenseId LicenseRef)
-> SimpleLicenseExpression
f = \case
        Left LicenseId
i -> LicenseId -> SimpleLicenseExpression
ELicenseId LicenseId
i
        Right (Left LicenseId
i) -> LicenseId -> SimpleLicenseExpression
ELicenseIdPlus LicenseId
i
        Right (Right LicenseRef
ref) -> LicenseRef -> SimpleLicenseExpression
ELicenseRef LicenseRef
ref
      g :: SimpleLicenseExpression
-> Either LicenseId (Either LicenseId LicenseRef)
g = \case
        ELicenseId LicenseId
i -> LicenseId -> Either LicenseId (Either LicenseId LicenseRef)
forall a b. a -> Either a b
Left LicenseId
i
        ELicenseIdPlus LicenseId
i -> Either LicenseId LicenseRef
-> Either LicenseId (Either LicenseId LicenseRef)
forall a b. b -> Either a b
Right (Either LicenseId LicenseRef
 -> Either LicenseId (Either LicenseId LicenseRef))
-> Either LicenseId LicenseRef
-> Either LicenseId (Either LicenseId LicenseRef)
forall a b. (a -> b) -> a -> b
$ LicenseId -> Either LicenseId LicenseRef
forall a b. a -> Either a b
Left LicenseId
i
        ELicenseRef LicenseRef
ref -> Either LicenseId LicenseRef
-> Either LicenseId (Either LicenseId LicenseRef)
forall a b. b -> Either a b
Right (Either LicenseId LicenseRef
 -> Either LicenseId (Either LicenseId LicenseRef))
-> Either LicenseId LicenseRef
-> Either LicenseId (Either LicenseId LicenseRef)
forall a b. (a -> b) -> a -> b
$ LicenseRef -> Either LicenseId LicenseRef
forall a b. b -> Either a b
Right LicenseRef
ref

instance HasCodec SPDX.LicenseId where
  codec :: JSONCodec LicenseId
codec = Text -> JSONCodec LicenseId -> JSONCodec LicenseId
forall input output.
Text -> ValueCodec input output -> ValueCodec input output
named Text
"SPDX.LicenseId" JSONCodec LicenseId
forall enum.
(Show enum, Eq enum, Enum enum, Bounded enum) =>
JSONCodec enum
shownBoundedEnumCodec

instance HasCodec SPDX.LicenseRef where
  codec :: JSONCodec LicenseRef
codec = ((Maybe String, String) -> LicenseRef)
-> (LicenseRef -> (Maybe String, String))
-> JSONCodec (Maybe String, String)
-> JSONCodec LicenseRef
forall oldOutput newOutput newInput oldInput context.
(oldOutput -> newOutput)
-> (newInput -> oldInput)
-> Codec context oldInput oldOutput
-> Codec context newInput newOutput
dimapCodec (Maybe String, String) -> LicenseRef
f LicenseRef -> (Maybe String, String)
g JSONCodec (Maybe String, String)
forall value. HasCodec value => JSONCodec value
codec
    where
      f :: (Maybe String, String) -> LicenseRef
f = (Maybe String -> String -> LicenseRef)
-> (Maybe String, String) -> LicenseRef
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Maybe String -> String -> LicenseRef
SPDX.mkLicenseRef'
      g :: LicenseRef -> (Maybe String, String)
g = \LicenseRef
l -> (LicenseRef -> Maybe String
SPDX.licenseDocumentRef LicenseRef
l, LicenseRef -> String
SPDX.licenseRef LicenseRef
l)

instance HasCodec SPDX.LicenseExceptionId where
  codec :: JSONCodec LicenseExceptionId
codec = JSONCodec LicenseExceptionId
forall enum.
(Show enum, Eq enum, Enum enum, Bounded enum) =>
JSONCodec enum
shownBoundedEnumCodec

instance HasCodec BuildType where
  codec :: JSONCodec BuildType
codec = NonEmpty (BuildType, Text) -> JSONCodec BuildType
forall constant.
Eq constant =>
NonEmpty (constant, Text) -> JSONCodec constant
stringConstCodec [(BuildType
Simple, Text
"Simple"), (BuildType
Configure, Text
"Configure"), (BuildType
Make, Text
"Make"), (BuildType
Custom, Text
"Custom")]

instance HasCodec SetupBuildInfo where
  codec :: JSONCodec SetupBuildInfo
codec =
    Text
-> ObjectCodec SetupBuildInfo SetupBuildInfo
-> JSONCodec SetupBuildInfo
forall input output.
Text -> ObjectCodec input output -> ValueCodec input output
object Text
"SetupBuildInfo" (ObjectCodec SetupBuildInfo SetupBuildInfo
 -> JSONCodec SetupBuildInfo)
-> ObjectCodec SetupBuildInfo SetupBuildInfo
-> JSONCodec SetupBuildInfo
forall a b. (a -> b) -> a -> b
$
      [Dependency] -> Bool -> SetupBuildInfo
SetupBuildInfo
        ([Dependency] -> Bool -> SetupBuildInfo)
-> Codec Object SetupBuildInfo [Dependency]
-> Codec Object SetupBuildInfo (Bool -> SetupBuildInfo)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> ObjectCodec [Dependency] [Dependency]
forall output. HasCodec output => Text -> ObjectCodec output output
requiredField' Text
"setup-depends" ObjectCodec [Dependency] [Dependency]
-> (SetupBuildInfo -> [Dependency])
-> Codec Object SetupBuildInfo [Dependency]
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
.= SetupBuildInfo -> [Dependency]
setupDepends
        -- TODO: not needed
        Codec Object SetupBuildInfo (Bool -> SetupBuildInfo)
-> Codec Object SetupBuildInfo Bool
-> ObjectCodec SetupBuildInfo SetupBuildInfo
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text -> ObjectCodec Bool Bool
forall output. HasCodec output => Text -> ObjectCodec output output
requiredField' Text
"__defaultSetupDepends" ObjectCodec Bool Bool
-> (SetupBuildInfo -> Bool) -> Codec Object SetupBuildInfo Bool
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
.= SetupBuildInfo -> Bool
defaultSetupDepends

instance HasCodec Flag where
  codec :: JSONCodec Flag
codec =
    Text -> ObjectCodec Flag Flag -> JSONCodec Flag
forall input output.
Text -> ObjectCodec input output -> ValueCodec input output
object Text
"Flag" (ObjectCodec Flag Flag -> JSONCodec Flag)
-> ObjectCodec Flag Flag -> JSONCodec Flag
forall a b. (a -> b) -> a -> b
$
      FlagName -> String -> Bool -> Bool -> Flag
MkFlag
        (FlagName -> String -> Bool -> Bool -> Flag)
-> Codec Object Flag FlagName
-> Codec Object Flag (String -> Bool -> Bool -> Flag)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> ObjectCodec FlagName FlagName
forall output. HasCodec output => Text -> ObjectCodec output output
requiredField' Text
"name" ObjectCodec FlagName FlagName
-> (Flag -> FlagName) -> Codec Object Flag FlagName
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
.= Flag -> FlagName
flagName
        Codec Object Flag (String -> Bool -> Bool -> Flag)
-> Codec Object Flag String
-> Codec Object Flag (Bool -> Bool -> Flag)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text -> ObjectCodec String String
forall output. HasCodec output => Text -> ObjectCodec output output
requiredField' Text
"description" ObjectCodec String String
-> (Flag -> String) -> Codec Object Flag String
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
.= Flag -> String
flagDescription
        Codec Object Flag (Bool -> Bool -> Flag)
-> Codec Object Flag Bool -> Codec Object Flag (Bool -> Flag)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text -> ObjectCodec Bool Bool
forall output. HasCodec output => Text -> ObjectCodec output output
requiredField' Text
"default" ObjectCodec Bool Bool -> (Flag -> Bool) -> Codec Object Flag Bool
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
.= Flag -> Bool
flagDefault
        Codec Object Flag (Bool -> Flag)
-> Codec Object Flag Bool -> ObjectCodec Flag Flag
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text -> ObjectCodec Bool Bool
forall output. HasCodec output => Text -> ObjectCodec output output
requiredField' Text
"manual" ObjectCodec Bool Bool -> (Flag -> Bool) -> Codec Object Flag Bool
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
.= Flag -> Bool
flagManual

instance HasCodec FlagName where
  codec :: JSONCodec FlagName
codec = (String -> FlagName)
-> (FlagName -> String)
-> Codec Value String String
-> JSONCodec FlagName
forall oldOutput newOutput newInput oldInput context.
(oldOutput -> newOutput)
-> (newInput -> oldInput)
-> Codec context oldInput oldOutput
-> Codec context newInput newOutput
dimapCodec String -> FlagName
mkFlagName FlagName -> String
unFlagName Codec Value String String
forall value. HasCodec value => JSONCodec value
codec

instance HasCodec a => HasCodec (CondTree ConfVar [Dependency] a) where
  codec :: JSONCodec (CondTree ConfVar [Dependency] a)
codec =
    Text
-> JSONCodec (CondTree ConfVar [Dependency] a)
-> JSONCodec (CondTree ConfVar [Dependency] a)
forall input output.
Text -> ValueCodec input output -> ValueCodec input output
named Text
"ConditionalTree" (JSONCodec (CondTree ConfVar [Dependency] a)
 -> JSONCodec (CondTree ConfVar [Dependency] a))
-> JSONCodec (CondTree ConfVar [Dependency] a)
-> JSONCodec (CondTree ConfVar [Dependency] a)
forall a b. (a -> b) -> a -> b
$
      Text
-> ObjectCodec
     (CondTree ConfVar [Dependency] a) (CondTree ConfVar [Dependency] a)
-> JSONCodec (CondTree ConfVar [Dependency] a)
forall input output.
Text -> ObjectCodec input output -> ValueCodec input output
object Text
"CondTree" (ObjectCodec
   (CondTree ConfVar [Dependency] a) (CondTree ConfVar [Dependency] a)
 -> JSONCodec (CondTree ConfVar [Dependency] a))
-> ObjectCodec
     (CondTree ConfVar [Dependency] a) (CondTree ConfVar [Dependency] a)
-> JSONCodec (CondTree ConfVar [Dependency] a)
forall a b. (a -> b) -> a -> b
$
        a
-> [Dependency]
-> [CondBranch ConfVar [Dependency] a]
-> CondTree ConfVar [Dependency] a
forall v c a. a -> c -> [CondBranch v c a] -> CondTree v c a
CondNode
          (a
 -> [Dependency]
 -> [CondBranch ConfVar [Dependency] a]
 -> CondTree ConfVar [Dependency] a)
-> Codec Object (CondTree ConfVar [Dependency] a) a
-> Codec
     Object
     (CondTree ConfVar [Dependency] a)
     ([Dependency]
      -> [CondBranch ConfVar [Dependency] a]
      -> CondTree ConfVar [Dependency] a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> ObjectCodec a a
forall output. HasCodec output => Text -> ObjectCodec output output
requiredField' Text
"condTreeData" ObjectCodec a a
-> (CondTree ConfVar [Dependency] a -> a)
-> Codec Object (CondTree ConfVar [Dependency] a) a
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
.= CondTree ConfVar [Dependency] a -> a
forall v c a. CondTree v c a -> a
condTreeData
          Codec
  Object
  (CondTree ConfVar [Dependency] a)
  ([Dependency]
   -> [CondBranch ConfVar [Dependency] a]
   -> CondTree ConfVar [Dependency] a)
-> Codec Object (CondTree ConfVar [Dependency] a) [Dependency]
-> Codec
     Object
     (CondTree ConfVar [Dependency] a)
     ([CondBranch ConfVar [Dependency] a]
      -> CondTree ConfVar [Dependency] a)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text -> ObjectCodec [Dependency] [Dependency]
forall output. HasCodec output => Text -> ObjectCodec output output
requiredField' Text
"condTreeConstraints" ObjectCodec [Dependency] [Dependency]
-> (CondTree ConfVar [Dependency] a -> [Dependency])
-> Codec Object (CondTree ConfVar [Dependency] a) [Dependency]
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
.= CondTree ConfVar [Dependency] a -> [Dependency]
forall v c a. CondTree v c a -> c
condTreeConstraints
          Codec
  Object
  (CondTree ConfVar [Dependency] a)
  ([CondBranch ConfVar [Dependency] a]
   -> CondTree ConfVar [Dependency] a)
-> Codec
     Object
     (CondTree ConfVar [Dependency] a)
     [CondBranch ConfVar [Dependency] a]
-> ObjectCodec
     (CondTree ConfVar [Dependency] a) (CondTree ConfVar [Dependency] a)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text
-> ObjectCodec
     [CondBranch ConfVar [Dependency] a]
     [CondBranch ConfVar [Dependency] a]
forall output. HasCodec output => Text -> ObjectCodec output output
requiredField' Text
"condTreeComponents" ObjectCodec
  [CondBranch ConfVar [Dependency] a]
  [CondBranch ConfVar [Dependency] a]
-> (CondTree ConfVar [Dependency] a
    -> [CondBranch ConfVar [Dependency] a])
-> Codec
     Object
     (CondTree ConfVar [Dependency] a)
     [CondBranch ConfVar [Dependency] a]
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
.= CondTree ConfVar [Dependency] a
-> [CondBranch ConfVar [Dependency] a]
forall v c a. CondTree v c a -> [CondBranch v c a]
condTreeComponents

instance (HasCodec a) => HasCodec (CondBranch ConfVar [Dependency] a) where
  codec :: JSONCodec (CondBranch ConfVar [Dependency] a)
codec =
    Text
-> ObjectCodec
     (CondBranch ConfVar [Dependency] a)
     (CondBranch ConfVar [Dependency] a)
-> JSONCodec (CondBranch ConfVar [Dependency] a)
forall input output.
Text -> ObjectCodec input output -> ValueCodec input output
object Text
"CondBranch" (ObjectCodec
   (CondBranch ConfVar [Dependency] a)
   (CondBranch ConfVar [Dependency] a)
 -> JSONCodec (CondBranch ConfVar [Dependency] a))
-> ObjectCodec
     (CondBranch ConfVar [Dependency] a)
     (CondBranch ConfVar [Dependency] a)
-> JSONCodec (CondBranch ConfVar [Dependency] a)
forall a b. (a -> b) -> a -> b
$
      Condition ConfVar
-> CondTree ConfVar [Dependency] a
-> Maybe (CondTree ConfVar [Dependency] a)
-> CondBranch ConfVar [Dependency] a
forall v c a.
Condition v
-> CondTree v c a -> Maybe (CondTree v c a) -> CondBranch v c a
CondBranch
        (Condition ConfVar
 -> CondTree ConfVar [Dependency] a
 -> Maybe (CondTree ConfVar [Dependency] a)
 -> CondBranch ConfVar [Dependency] a)
-> Codec
     Object (CondBranch ConfVar [Dependency] a) (Condition ConfVar)
-> Codec
     Object
     (CondBranch ConfVar [Dependency] a)
     (CondTree ConfVar [Dependency] a
      -> Maybe (CondTree ConfVar [Dependency] a)
      -> CondBranch ConfVar [Dependency] a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> ObjectCodec (Condition ConfVar) (Condition ConfVar)
forall output. HasCodec output => Text -> ObjectCodec output output
requiredField' Text
"condBranchCondition" ObjectCodec (Condition ConfVar) (Condition ConfVar)
-> (CondBranch ConfVar [Dependency] a -> Condition ConfVar)
-> Codec
     Object (CondBranch ConfVar [Dependency] a) (Condition ConfVar)
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
.= CondBranch ConfVar [Dependency] a -> Condition ConfVar
forall v c a. CondBranch v c a -> Condition v
condBranchCondition
        Codec
  Object
  (CondBranch ConfVar [Dependency] a)
  (CondTree ConfVar [Dependency] a
   -> Maybe (CondTree ConfVar [Dependency] a)
   -> CondBranch ConfVar [Dependency] a)
-> Codec
     Object
     (CondBranch ConfVar [Dependency] a)
     (CondTree ConfVar [Dependency] a)
-> Codec
     Object
     (CondBranch ConfVar [Dependency] a)
     (Maybe (CondTree ConfVar [Dependency] a)
      -> CondBranch ConfVar [Dependency] a)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text
-> ObjectCodec
     (CondTree ConfVar [Dependency] a) (CondTree ConfVar [Dependency] a)
forall output. HasCodec output => Text -> ObjectCodec output output
requiredField' Text
"condBranchIfTrue" ObjectCodec
  (CondTree ConfVar [Dependency] a) (CondTree ConfVar [Dependency] a)
-> (CondBranch ConfVar [Dependency] a
    -> CondTree ConfVar [Dependency] a)
-> Codec
     Object
     (CondBranch ConfVar [Dependency] a)
     (CondTree ConfVar [Dependency] a)
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
.= CondBranch ConfVar [Dependency] a
-> CondTree ConfVar [Dependency] a
forall v c a. CondBranch v c a -> CondTree v c a
condBranchIfTrue
        Codec
  Object
  (CondBranch ConfVar [Dependency] a)
  (Maybe (CondTree ConfVar [Dependency] a)
   -> CondBranch ConfVar [Dependency] a)
-> Codec
     Object
     (CondBranch ConfVar [Dependency] a)
     (Maybe (CondTree ConfVar [Dependency] a))
-> ObjectCodec
     (CondBranch ConfVar [Dependency] a)
     (CondBranch ConfVar [Dependency] a)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text
-> ObjectCodec
     (Maybe (CondTree ConfVar [Dependency] a))
     (Maybe (CondTree ConfVar [Dependency] a))
forall output.
HasCodec output =>
Text -> ObjectCodec (Maybe output) (Maybe output)
optionalField' Text
"condBranchIfFalse" ObjectCodec
  (Maybe (CondTree ConfVar [Dependency] a))
  (Maybe (CondTree ConfVar [Dependency] a))
-> (CondBranch ConfVar [Dependency] a
    -> Maybe (CondTree ConfVar [Dependency] a))
-> Codec
     Object
     (CondBranch ConfVar [Dependency] a)
     (Maybe (CondTree ConfVar [Dependency] a))
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
.= CondBranch ConfVar [Dependency] a
-> Maybe (CondTree ConfVar [Dependency] a)
forall v c a. CondBranch v c a -> Maybe (CondTree v c a)
condBranchIfFalse

instance HasCodec (Condition ConfVar) where
  codec :: JSONCodec (Condition ConfVar)
codec =
    Text
-> JSONCodec (Condition ConfVar) -> JSONCodec (Condition ConfVar)
forall input output.
Text -> ValueCodec input output -> ValueCodec input output
named Text
"Condition" (JSONCodec (Condition ConfVar) -> JSONCodec (Condition ConfVar))
-> JSONCodec (Condition ConfVar) -> JSONCodec (Condition ConfVar)
forall a b. (a -> b) -> a -> b
$
      (Either
   ConfVar
   (Either
      Bool
      (Either
         (Condition ConfVar)
         (Either
            (Condition ConfVar, Condition ConfVar)
            (Condition ConfVar, Condition ConfVar))))
 -> Condition ConfVar)
-> (Condition ConfVar
    -> Either
         ConfVar
         (Either
            Bool
            (Either
               (Condition ConfVar)
               (Either
                  (Condition ConfVar, Condition ConfVar)
                  (Condition ConfVar, Condition ConfVar)))))
-> Codec
     Value
     (Either
        ConfVar
        (Either
           Bool
           (Either
              (Condition ConfVar)
              (Either
                 (Condition ConfVar, Condition ConfVar)
                 (Condition ConfVar, Condition ConfVar)))))
     (Either
        ConfVar
        (Either
           Bool
           (Either
              (Condition ConfVar)
              (Either
                 (Condition ConfVar, Condition ConfVar)
                 (Condition ConfVar, Condition ConfVar)))))
-> JSONCodec (Condition ConfVar)
forall oldOutput newOutput newInput oldInput context.
(oldOutput -> newOutput)
-> (newInput -> oldInput)
-> Codec context oldInput oldOutput
-> Codec context newInput newOutput
dimapCodec Either
  ConfVar
  (Either
     Bool
     (Either
        (Condition ConfVar)
        (Either
           (Condition ConfVar, Condition ConfVar)
           (Condition ConfVar, Condition ConfVar))))
-> Condition ConfVar
forall c.
Either
  c
  (Either
     Bool
     (Either
        (Condition c)
        (Either (Condition c, Condition c) (Condition c, Condition c))))
-> Condition c
f Condition ConfVar
-> Either
     ConfVar
     (Either
        Bool
        (Either
           (Condition ConfVar)
           (Either
              (Condition ConfVar, Condition ConfVar)
              (Condition ConfVar, Condition ConfVar))))
forall a.
Condition a
-> Either
     a
     (Either
        Bool
        (Either
           (Condition a)
           (Either (Condition a, Condition a) (Condition a, Condition a))))
g (Codec
   Value
   (Either
      ConfVar
      (Either
         Bool
         (Either
            (Condition ConfVar)
            (Either
               (Condition ConfVar, Condition ConfVar)
               (Condition ConfVar, Condition ConfVar)))))
   (Either
      ConfVar
      (Either
         Bool
         (Either
            (Condition ConfVar)
            (Either
               (Condition ConfVar, Condition ConfVar)
               (Condition ConfVar, Condition ConfVar)))))
 -> JSONCodec (Condition ConfVar))
-> Codec
     Value
     (Either
        ConfVar
        (Either
           Bool
           (Either
              (Condition ConfVar)
              (Either
                 (Condition ConfVar, Condition ConfVar)
                 (Condition ConfVar, Condition ConfVar)))))
     (Either
        ConfVar
        (Either
           Bool
           (Either
              (Condition ConfVar)
              (Either
                 (Condition ConfVar, Condition ConfVar)
                 (Condition ConfVar, Condition ConfVar)))))
-> JSONCodec (Condition ConfVar)
forall a b. (a -> b) -> a -> b
$
        Codec Value ConfVar ConfVar
-> Codec
     Value
     (Either
        Bool
        (Either
           (Condition ConfVar)
           (Either
              (Condition ConfVar, Condition ConfVar)
              (Condition ConfVar, Condition ConfVar))))
     (Either
        Bool
        (Either
           (Condition ConfVar)
           (Either
              (Condition ConfVar, Condition ConfVar)
              (Condition ConfVar, Condition ConfVar))))
-> Codec
     Value
     (Either
        ConfVar
        (Either
           Bool
           (Either
              (Condition ConfVar)
              (Either
                 (Condition ConfVar, Condition ConfVar)
                 (Condition ConfVar, Condition ConfVar)))))
     (Either
        ConfVar
        (Either
           Bool
           (Either
              (Condition ConfVar)
              (Either
                 (Condition ConfVar, Condition ConfVar)
                 (Condition ConfVar, Condition ConfVar)))))
forall context input1 output1 input2 output2.
Codec context input1 output1
-> Codec context input2 output2
-> Codec context (Either input1 input2) (Either output1 output2)
eitherCodec (Text -> ObjectCodec ConfVar ConfVar -> Codec Value ConfVar ConfVar
forall input output.
Text -> ObjectCodec input output -> ValueCodec input output
object Text
"var" (ObjectCodec ConfVar ConfVar -> Codec Value ConfVar ConfVar)
-> ObjectCodec ConfVar ConfVar -> Codec Value ConfVar ConfVar
forall a b. (a -> b) -> a -> b
$ Text -> ObjectCodec ConfVar ConfVar
forall output. HasCodec output => Text -> ObjectCodec output output
requiredField' Text
"v") (Codec
   Value
   (Either
      Bool
      (Either
         (Condition ConfVar)
         (Either
            (Condition ConfVar, Condition ConfVar)
            (Condition ConfVar, Condition ConfVar))))
   (Either
      Bool
      (Either
         (Condition ConfVar)
         (Either
            (Condition ConfVar, Condition ConfVar)
            (Condition ConfVar, Condition ConfVar))))
 -> Codec
      Value
      (Either
         ConfVar
         (Either
            Bool
            (Either
               (Condition ConfVar)
               (Either
                  (Condition ConfVar, Condition ConfVar)
                  (Condition ConfVar, Condition ConfVar)))))
      (Either
         ConfVar
         (Either
            Bool
            (Either
               (Condition ConfVar)
               (Either
                  (Condition ConfVar, Condition ConfVar)
                  (Condition ConfVar, Condition ConfVar))))))
-> Codec
     Value
     (Either
        Bool
        (Either
           (Condition ConfVar)
           (Either
              (Condition ConfVar, Condition ConfVar)
              (Condition ConfVar, Condition ConfVar))))
     (Either
        Bool
        (Either
           (Condition ConfVar)
           (Either
              (Condition ConfVar, Condition ConfVar)
              (Condition ConfVar, Condition ConfVar))))
-> Codec
     Value
     (Either
        ConfVar
        (Either
           Bool
           (Either
              (Condition ConfVar)
              (Either
                 (Condition ConfVar, Condition ConfVar)
                 (Condition ConfVar, Condition ConfVar)))))
     (Either
        ConfVar
        (Either
           Bool
           (Either
              (Condition ConfVar)
              (Either
                 (Condition ConfVar, Condition ConfVar)
                 (Condition ConfVar, Condition ConfVar)))))
forall a b. (a -> b) -> a -> b
$
          Codec Value Bool Bool
-> Codec
     Value
     (Either
        (Condition ConfVar)
        (Either
           (Condition ConfVar, Condition ConfVar)
           (Condition ConfVar, Condition ConfVar)))
     (Either
        (Condition ConfVar)
        (Either
           (Condition ConfVar, Condition ConfVar)
           (Condition ConfVar, Condition ConfVar)))
-> Codec
     Value
     (Either
        Bool
        (Either
           (Condition ConfVar)
           (Either
              (Condition ConfVar, Condition ConfVar)
              (Condition ConfVar, Condition ConfVar))))
     (Either
        Bool
        (Either
           (Condition ConfVar)
           (Either
              (Condition ConfVar, Condition ConfVar)
              (Condition ConfVar, Condition ConfVar))))
forall context input1 output1 input2 output2.
Codec context input1 output1
-> Codec context input2 output2
-> Codec context (Either input1 input2) (Either output1 output2)
eitherCodec (Text -> ObjectCodec Bool Bool -> Codec Value Bool Bool
forall input output.
Text -> ObjectCodec input output -> ValueCodec input output
object Text
"lit" (ObjectCodec Bool Bool -> Codec Value Bool Bool)
-> ObjectCodec Bool Bool -> Codec Value Bool Bool
forall a b. (a -> b) -> a -> b
$ Text -> ObjectCodec Bool Bool
forall output. HasCodec output => Text -> ObjectCodec output output
requiredField' Text
"bool") (Codec
   Value
   (Either
      (Condition ConfVar)
      (Either
         (Condition ConfVar, Condition ConfVar)
         (Condition ConfVar, Condition ConfVar)))
   (Either
      (Condition ConfVar)
      (Either
         (Condition ConfVar, Condition ConfVar)
         (Condition ConfVar, Condition ConfVar)))
 -> Codec
      Value
      (Either
         Bool
         (Either
            (Condition ConfVar)
            (Either
               (Condition ConfVar, Condition ConfVar)
               (Condition ConfVar, Condition ConfVar))))
      (Either
         Bool
         (Either
            (Condition ConfVar)
            (Either
               (Condition ConfVar, Condition ConfVar)
               (Condition ConfVar, Condition ConfVar)))))
-> Codec
     Value
     (Either
        (Condition ConfVar)
        (Either
           (Condition ConfVar, Condition ConfVar)
           (Condition ConfVar, Condition ConfVar)))
     (Either
        (Condition ConfVar)
        (Either
           (Condition ConfVar, Condition ConfVar)
           (Condition ConfVar, Condition ConfVar)))
-> Codec
     Value
     (Either
        Bool
        (Either
           (Condition ConfVar)
           (Either
              (Condition ConfVar, Condition ConfVar)
              (Condition ConfVar, Condition ConfVar))))
     (Either
        Bool
        (Either
           (Condition ConfVar)
           (Either
              (Condition ConfVar, Condition ConfVar)
              (Condition ConfVar, Condition ConfVar))))
forall a b. (a -> b) -> a -> b
$
            JSONCodec (Condition ConfVar)
-> Codec
     Value
     (Either
        (Condition ConfVar, Condition ConfVar)
        (Condition ConfVar, Condition ConfVar))
     (Either
        (Condition ConfVar, Condition ConfVar)
        (Condition ConfVar, Condition ConfVar))
-> Codec
     Value
     (Either
        (Condition ConfVar)
        (Either
           (Condition ConfVar, Condition ConfVar)
           (Condition ConfVar, Condition ConfVar)))
     (Either
        (Condition ConfVar)
        (Either
           (Condition ConfVar, Condition ConfVar)
           (Condition ConfVar, Condition ConfVar)))
forall context input1 output1 input2 output2.
Codec context input1 output1
-> Codec context input2 output2
-> Codec context (Either input1 input2) (Either output1 output2)
eitherCodec (Text
-> ObjectCodec (Condition ConfVar) (Condition ConfVar)
-> JSONCodec (Condition ConfVar)
forall input output.
Text -> ObjectCodec input output -> ValueCodec input output
object Text
"cnot" (ObjectCodec (Condition ConfVar) (Condition ConfVar)
 -> JSONCodec (Condition ConfVar))
-> ObjectCodec (Condition ConfVar) (Condition ConfVar)
-> JSONCodec (Condition ConfVar)
forall a b. (a -> b) -> a -> b
$ Text -> ObjectCodec (Condition ConfVar) (Condition ConfVar)
forall output. HasCodec output => Text -> ObjectCodec output output
requiredField' Text
"cond") (Codec
   Value
   (Either
      (Condition ConfVar, Condition ConfVar)
      (Condition ConfVar, Condition ConfVar))
   (Either
      (Condition ConfVar, Condition ConfVar)
      (Condition ConfVar, Condition ConfVar))
 -> Codec
      Value
      (Either
         (Condition ConfVar)
         (Either
            (Condition ConfVar, Condition ConfVar)
            (Condition ConfVar, Condition ConfVar)))
      (Either
         (Condition ConfVar)
         (Either
            (Condition ConfVar, Condition ConfVar)
            (Condition ConfVar, Condition ConfVar))))
-> Codec
     Value
     (Either
        (Condition ConfVar, Condition ConfVar)
        (Condition ConfVar, Condition ConfVar))
     (Either
        (Condition ConfVar, Condition ConfVar)
        (Condition ConfVar, Condition ConfVar))
-> Codec
     Value
     (Either
        (Condition ConfVar)
        (Either
           (Condition ConfVar, Condition ConfVar)
           (Condition ConfVar, Condition ConfVar)))
     (Either
        (Condition ConfVar)
        (Either
           (Condition ConfVar, Condition ConfVar)
           (Condition ConfVar, Condition ConfVar)))
forall a b. (a -> b) -> a -> b
$
              Codec
  Value
  (Condition ConfVar, Condition ConfVar)
  (Condition ConfVar, Condition ConfVar)
-> Codec
     Value
     (Condition ConfVar, Condition ConfVar)
     (Condition ConfVar, Condition ConfVar)
-> Codec
     Value
     (Either
        (Condition ConfVar, Condition ConfVar)
        (Condition ConfVar, Condition ConfVar))
     (Either
        (Condition ConfVar, Condition ConfVar)
        (Condition ConfVar, Condition ConfVar))
forall context input1 output1 input2 output2.
Codec context input1 output1
-> Codec context input2 output2
-> Codec context (Either input1 input2) (Either output1 output2)
eitherCodec (Text
-> ObjectCodec
     (Condition ConfVar, Condition ConfVar)
     (Condition ConfVar, Condition ConfVar)
-> Codec
     Value
     (Condition ConfVar, Condition ConfVar)
     (Condition ConfVar, Condition ConfVar)
forall input output.
Text -> ObjectCodec input output -> ValueCodec input output
object Text
"cor" (ObjectCodec
   (Condition ConfVar, Condition ConfVar)
   (Condition ConfVar, Condition ConfVar)
 -> Codec
      Value
      (Condition ConfVar, Condition ConfVar)
      (Condition ConfVar, Condition ConfVar))
-> ObjectCodec
     (Condition ConfVar, Condition ConfVar)
     (Condition ConfVar, Condition ConfVar)
-> Codec
     Value
     (Condition ConfVar, Condition ConfVar)
     (Condition ConfVar, Condition ConfVar)
forall a b. (a -> b) -> a -> b
$ (,) (Condition ConfVar
 -> Condition ConfVar -> (Condition ConfVar, Condition ConfVar))
-> Codec
     Object (Condition ConfVar, Condition ConfVar) (Condition ConfVar)
-> Codec
     Object
     (Condition ConfVar, Condition ConfVar)
     (Condition ConfVar -> (Condition ConfVar, Condition ConfVar))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> ObjectCodec (Condition ConfVar) (Condition ConfVar)
forall output. HasCodec output => Text -> ObjectCodec output output
requiredField' Text
"cond1" ObjectCodec (Condition ConfVar) (Condition ConfVar)
-> ((Condition ConfVar, Condition ConfVar) -> Condition ConfVar)
-> Codec
     Object (Condition ConfVar, Condition ConfVar) (Condition ConfVar)
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
.= (Condition ConfVar, Condition ConfVar) -> Condition ConfVar
forall a b. (a, b) -> a
fst Codec
  Object
  (Condition ConfVar, Condition ConfVar)
  (Condition ConfVar -> (Condition ConfVar, Condition ConfVar))
-> Codec
     Object (Condition ConfVar, Condition ConfVar) (Condition ConfVar)
-> ObjectCodec
     (Condition ConfVar, Condition ConfVar)
     (Condition ConfVar, Condition ConfVar)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text -> ObjectCodec (Condition ConfVar) (Condition ConfVar)
forall output. HasCodec output => Text -> ObjectCodec output output
requiredField' Text
"cond2" ObjectCodec (Condition ConfVar) (Condition ConfVar)
-> ((Condition ConfVar, Condition ConfVar) -> Condition ConfVar)
-> Codec
     Object (Condition ConfVar, Condition ConfVar) (Condition ConfVar)
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
.= (Condition ConfVar, Condition ConfVar) -> Condition ConfVar
forall a b. (a, b) -> b
snd) (Codec
   Value
   (Condition ConfVar, Condition ConfVar)
   (Condition ConfVar, Condition ConfVar)
 -> Codec
      Value
      (Either
         (Condition ConfVar, Condition ConfVar)
         (Condition ConfVar, Condition ConfVar))
      (Either
         (Condition ConfVar, Condition ConfVar)
         (Condition ConfVar, Condition ConfVar)))
-> Codec
     Value
     (Condition ConfVar, Condition ConfVar)
     (Condition ConfVar, Condition ConfVar)
-> Codec
     Value
     (Either
        (Condition ConfVar, Condition ConfVar)
        (Condition ConfVar, Condition ConfVar))
     (Either
        (Condition ConfVar, Condition ConfVar)
        (Condition ConfVar, Condition ConfVar))
forall a b. (a -> b) -> a -> b
$
                Text
-> ObjectCodec
     (Condition ConfVar, Condition ConfVar)
     (Condition ConfVar, Condition ConfVar)
-> Codec
     Value
     (Condition ConfVar, Condition ConfVar)
     (Condition ConfVar, Condition ConfVar)
forall input output.
Text -> ObjectCodec input output -> ValueCodec input output
object Text
"cand" (ObjectCodec
   (Condition ConfVar, Condition ConfVar)
   (Condition ConfVar, Condition ConfVar)
 -> Codec
      Value
      (Condition ConfVar, Condition ConfVar)
      (Condition ConfVar, Condition ConfVar))
-> ObjectCodec
     (Condition ConfVar, Condition ConfVar)
     (Condition ConfVar, Condition ConfVar)
-> Codec
     Value
     (Condition ConfVar, Condition ConfVar)
     (Condition ConfVar, Condition ConfVar)
forall a b. (a -> b) -> a -> b
$ (,) (Condition ConfVar
 -> Condition ConfVar -> (Condition ConfVar, Condition ConfVar))
-> Codec
     Object (Condition ConfVar, Condition ConfVar) (Condition ConfVar)
-> Codec
     Object
     (Condition ConfVar, Condition ConfVar)
     (Condition ConfVar -> (Condition ConfVar, Condition ConfVar))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> ObjectCodec (Condition ConfVar) (Condition ConfVar)
forall output. HasCodec output => Text -> ObjectCodec output output
requiredField' Text
"cond12" ObjectCodec (Condition ConfVar) (Condition ConfVar)
-> ((Condition ConfVar, Condition ConfVar) -> Condition ConfVar)
-> Codec
     Object (Condition ConfVar, Condition ConfVar) (Condition ConfVar)
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
.= (Condition ConfVar, Condition ConfVar) -> Condition ConfVar
forall a b. (a, b) -> a
fst Codec
  Object
  (Condition ConfVar, Condition ConfVar)
  (Condition ConfVar -> (Condition ConfVar, Condition ConfVar))
-> Codec
     Object (Condition ConfVar, Condition ConfVar) (Condition ConfVar)
-> ObjectCodec
     (Condition ConfVar, Condition ConfVar)
     (Condition ConfVar, Condition ConfVar)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text -> ObjectCodec (Condition ConfVar) (Condition ConfVar)
forall output. HasCodec output => Text -> ObjectCodec output output
requiredField' Text
"cond22" ObjectCodec (Condition ConfVar) (Condition ConfVar)
-> ((Condition ConfVar, Condition ConfVar) -> Condition ConfVar)
-> Codec
     Object (Condition ConfVar, Condition ConfVar) (Condition ConfVar)
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
.= (Condition ConfVar, Condition ConfVar) -> Condition ConfVar
forall a b. (a, b) -> b
snd
    where
      f :: Either
  c
  (Either
     Bool
     (Either
        (Condition c)
        (Either (Condition c, Condition c) (Condition c, Condition c))))
-> Condition c
f = \case
        Left c
c -> c -> Condition c
forall c. c -> Condition c
Var c
c
        Right (Left Bool
b) -> Bool -> Condition c
forall c. Bool -> Condition c
Lit Bool
b
        Right (Right (Left Condition c
cond)) -> Condition c -> Condition c
forall c. Condition c -> Condition c
CNot Condition c
cond
        Right (Right (Right (Left (Condition c
cond1, Condition c
cond2)))) -> Condition c -> Condition c -> Condition c
forall c. Condition c -> Condition c -> Condition c
COr Condition c
cond1 Condition c
cond2
        Right (Right (Right (Right (Condition c
cond1, Condition c
cond2)))) -> Condition c -> Condition c -> Condition c
forall c. Condition c -> Condition c -> Condition c
CAnd Condition c
cond1 Condition c
cond2
      g :: Condition a
-> Either
     a
     (Either
        Bool
        (Either
           (Condition a)
           (Either (Condition a, Condition a) (Condition a, Condition a))))
g = \case
        Var a
c -> a
-> Either
     a
     (Either
        Bool
        (Either
           (Condition a)
           (Either (Condition a, Condition a) (Condition a, Condition a))))
forall a b. a -> Either a b
Left a
c
        Lit Bool
b -> Either
  Bool
  (Either
     (Condition a)
     (Either (Condition a, Condition a) (Condition a, Condition a)))
-> Either
     a
     (Either
        Bool
        (Either
           (Condition a)
           (Either (Condition a, Condition a) (Condition a, Condition a))))
forall a b. b -> Either a b
Right (Either
   Bool
   (Either
      (Condition a)
      (Either (Condition a, Condition a) (Condition a, Condition a)))
 -> Either
      a
      (Either
         Bool
         (Either
            (Condition a)
            (Either (Condition a, Condition a) (Condition a, Condition a)))))
-> Either
     Bool
     (Either
        (Condition a)
        (Either (Condition a, Condition a) (Condition a, Condition a)))
-> Either
     a
     (Either
        Bool
        (Either
           (Condition a)
           (Either (Condition a, Condition a) (Condition a, Condition a))))
forall a b. (a -> b) -> a -> b
$ Bool
-> Either
     Bool
     (Either
        (Condition a)
        (Either (Condition a, Condition a) (Condition a, Condition a)))
forall a b. a -> Either a b
Left Bool
b
        CNot Condition a
cond -> Either
  Bool
  (Either
     (Condition a)
     (Either (Condition a, Condition a) (Condition a, Condition a)))
-> Either
     a
     (Either
        Bool
        (Either
           (Condition a)
           (Either (Condition a, Condition a) (Condition a, Condition a))))
forall a b. b -> Either a b
Right (Either
   Bool
   (Either
      (Condition a)
      (Either (Condition a, Condition a) (Condition a, Condition a)))
 -> Either
      a
      (Either
         Bool
         (Either
            (Condition a)
            (Either (Condition a, Condition a) (Condition a, Condition a)))))
-> Either
     Bool
     (Either
        (Condition a)
        (Either (Condition a, Condition a) (Condition a, Condition a)))
-> Either
     a
     (Either
        Bool
        (Either
           (Condition a)
           (Either (Condition a, Condition a) (Condition a, Condition a))))
forall a b. (a -> b) -> a -> b
$ Either
  (Condition a)
  (Either (Condition a, Condition a) (Condition a, Condition a))
-> Either
     Bool
     (Either
        (Condition a)
        (Either (Condition a, Condition a) (Condition a, Condition a)))
forall a b. b -> Either a b
Right (Either
   (Condition a)
   (Either (Condition a, Condition a) (Condition a, Condition a))
 -> Either
      Bool
      (Either
         (Condition a)
         (Either (Condition a, Condition a) (Condition a, Condition a))))
-> Either
     (Condition a)
     (Either (Condition a, Condition a) (Condition a, Condition a))
-> Either
     Bool
     (Either
        (Condition a)
        (Either (Condition a, Condition a) (Condition a, Condition a)))
forall a b. (a -> b) -> a -> b
$ Condition a
-> Either
     (Condition a)
     (Either (Condition a, Condition a) (Condition a, Condition a))
forall a b. a -> Either a b
Left Condition a
cond
        COr Condition a
cond1 Condition a
cond2 -> Either
  Bool
  (Either
     (Condition a)
     (Either (Condition a, Condition a) (Condition a, Condition a)))
-> Either
     a
     (Either
        Bool
        (Either
           (Condition a)
           (Either (Condition a, Condition a) (Condition a, Condition a))))
forall a b. b -> Either a b
Right (Either
   Bool
   (Either
      (Condition a)
      (Either (Condition a, Condition a) (Condition a, Condition a)))
 -> Either
      a
      (Either
         Bool
         (Either
            (Condition a)
            (Either (Condition a, Condition a) (Condition a, Condition a)))))
-> Either
     Bool
     (Either
        (Condition a)
        (Either (Condition a, Condition a) (Condition a, Condition a)))
-> Either
     a
     (Either
        Bool
        (Either
           (Condition a)
           (Either (Condition a, Condition a) (Condition a, Condition a))))
forall a b. (a -> b) -> a -> b
$ Either
  (Condition a)
  (Either (Condition a, Condition a) (Condition a, Condition a))
-> Either
     Bool
     (Either
        (Condition a)
        (Either (Condition a, Condition a) (Condition a, Condition a)))
forall a b. b -> Either a b
Right (Either
   (Condition a)
   (Either (Condition a, Condition a) (Condition a, Condition a))
 -> Either
      Bool
      (Either
         (Condition a)
         (Either (Condition a, Condition a) (Condition a, Condition a))))
-> Either
     (Condition a)
     (Either (Condition a, Condition a) (Condition a, Condition a))
-> Either
     Bool
     (Either
        (Condition a)
        (Either (Condition a, Condition a) (Condition a, Condition a)))
forall a b. (a -> b) -> a -> b
$ Either (Condition a, Condition a) (Condition a, Condition a)
-> Either
     (Condition a)
     (Either (Condition a, Condition a) (Condition a, Condition a))
forall a b. b -> Either a b
Right (Either (Condition a, Condition a) (Condition a, Condition a)
 -> Either
      (Condition a)
      (Either (Condition a, Condition a) (Condition a, Condition a)))
-> Either (Condition a, Condition a) (Condition a, Condition a)
-> Either
     (Condition a)
     (Either (Condition a, Condition a) (Condition a, Condition a))
forall a b. (a -> b) -> a -> b
$ (Condition a, Condition a)
-> Either (Condition a, Condition a) (Condition a, Condition a)
forall a b. a -> Either a b
Left (Condition a
cond1, Condition a
cond2)
        CAnd Condition a
cond1 Condition a
cond2 -> Either
  Bool
  (Either
     (Condition a)
     (Either (Condition a, Condition a) (Condition a, Condition a)))
-> Either
     a
     (Either
        Bool
        (Either
           (Condition a)
           (Either (Condition a, Condition a) (Condition a, Condition a))))
forall a b. b -> Either a b
Right (Either
   Bool
   (Either
      (Condition a)
      (Either (Condition a, Condition a) (Condition a, Condition a)))
 -> Either
      a
      (Either
         Bool
         (Either
            (Condition a)
            (Either (Condition a, Condition a) (Condition a, Condition a)))))
-> Either
     Bool
     (Either
        (Condition a)
        (Either (Condition a, Condition a) (Condition a, Condition a)))
-> Either
     a
     (Either
        Bool
        (Either
           (Condition a)
           (Either (Condition a, Condition a) (Condition a, Condition a))))
forall a b. (a -> b) -> a -> b
$ Either
  (Condition a)
  (Either (Condition a, Condition a) (Condition a, Condition a))
-> Either
     Bool
     (Either
        (Condition a)
        (Either (Condition a, Condition a) (Condition a, Condition a)))
forall a b. b -> Either a b
Right (Either
   (Condition a)
   (Either (Condition a, Condition a) (Condition a, Condition a))
 -> Either
      Bool
      (Either
         (Condition a)
         (Either (Condition a, Condition a) (Condition a, Condition a))))
-> Either
     (Condition a)
     (Either (Condition a, Condition a) (Condition a, Condition a))
-> Either
     Bool
     (Either
        (Condition a)
        (Either (Condition a, Condition a) (Condition a, Condition a)))
forall a b. (a -> b) -> a -> b
$ Either (Condition a, Condition a) (Condition a, Condition a)
-> Either
     (Condition a)
     (Either (Condition a, Condition a) (Condition a, Condition a))
forall a b. b -> Either a b
Right (Either (Condition a, Condition a) (Condition a, Condition a)
 -> Either
      (Condition a)
      (Either (Condition a, Condition a) (Condition a, Condition a)))
-> Either (Condition a, Condition a) (Condition a, Condition a)
-> Either
     (Condition a)
     (Either (Condition a, Condition a) (Condition a, Condition a))
forall a b. (a -> b) -> a -> b
$ (Condition a, Condition a)
-> Either (Condition a, Condition a) (Condition a, Condition a)
forall a b. b -> Either a b
Right (Condition a
cond1, Condition a
cond2)

instance HasCodec ConfVar where
  codec :: Codec Value ConfVar ConfVar
codec =
    Text -> ObjectCodec ConfVar ConfVar -> Codec Value ConfVar ConfVar
forall input output.
Text -> ObjectCodec input output -> ValueCodec input output
object Text
"ConfVar" (ObjectCodec ConfVar ConfVar -> Codec Value ConfVar ConfVar)
-> ObjectCodec ConfVar ConfVar -> Codec Value ConfVar ConfVar
forall a b. (a -> b) -> a -> b
$
      (Either
   OS (Either Arch (Either FlagName (CompilerFlavor, VersionRange)))
 -> ConfVar)
-> (ConfVar
    -> Either
         OS (Either Arch (Either FlagName (CompilerFlavor, VersionRange))))
-> Codec
     Object
     (Either
        OS (Either Arch (Either FlagName (CompilerFlavor, VersionRange))))
     (Either
        OS (Either Arch (Either FlagName (CompilerFlavor, VersionRange))))
-> ObjectCodec ConfVar ConfVar
forall oldOutput newOutput newInput oldInput context.
(oldOutput -> newOutput)
-> (newInput -> oldInput)
-> Codec context oldInput oldOutput
-> Codec context newInput newOutput
dimapCodec Either
  OS (Either Arch (Either FlagName (CompilerFlavor, VersionRange)))
-> ConfVar
f ConfVar
-> Either
     OS (Either Arch (Either FlagName (CompilerFlavor, VersionRange)))
g (Codec
   Object
   (Either
      OS (Either Arch (Either FlagName (CompilerFlavor, VersionRange))))
   (Either
      OS (Either Arch (Either FlagName (CompilerFlavor, VersionRange))))
 -> ObjectCodec ConfVar ConfVar)
-> Codec
     Object
     (Either
        OS (Either Arch (Either FlagName (CompilerFlavor, VersionRange))))
     (Either
        OS (Either Arch (Either FlagName (CompilerFlavor, VersionRange))))
-> ObjectCodec ConfVar ConfVar
forall a b. (a -> b) -> a -> b
$
        Codec Object OS OS
-> Codec
     Object
     (Either Arch (Either FlagName (CompilerFlavor, VersionRange)))
     (Either Arch (Either FlagName (CompilerFlavor, VersionRange)))
-> Codec
     Object
     (Either
        OS (Either Arch (Either FlagName (CompilerFlavor, VersionRange))))
     (Either
        OS (Either Arch (Either FlagName (CompilerFlavor, VersionRange))))
forall context input1 output1 input2 output2.
Codec context input1 output1
-> Codec context input2 output2
-> Codec context (Either input1 input2) (Either output1 output2)
eitherCodec (Text -> Codec Object OS OS
forall output. HasCodec output => Text -> ObjectCodec output output
requiredField' Text
"os") (Codec
   Object
   (Either Arch (Either FlagName (CompilerFlavor, VersionRange)))
   (Either Arch (Either FlagName (CompilerFlavor, VersionRange)))
 -> Codec
      Object
      (Either
         OS (Either Arch (Either FlagName (CompilerFlavor, VersionRange))))
      (Either
         OS (Either Arch (Either FlagName (CompilerFlavor, VersionRange)))))
-> Codec
     Object
     (Either Arch (Either FlagName (CompilerFlavor, VersionRange)))
     (Either Arch (Either FlagName (CompilerFlavor, VersionRange)))
-> Codec
     Object
     (Either
        OS (Either Arch (Either FlagName (CompilerFlavor, VersionRange))))
     (Either
        OS (Either Arch (Either FlagName (CompilerFlavor, VersionRange))))
forall a b. (a -> b) -> a -> b
$
          Codec Object Arch Arch
-> Codec
     Object
     (Either FlagName (CompilerFlavor, VersionRange))
     (Either FlagName (CompilerFlavor, VersionRange))
-> Codec
     Object
     (Either Arch (Either FlagName (CompilerFlavor, VersionRange)))
     (Either Arch (Either FlagName (CompilerFlavor, VersionRange)))
forall context input1 output1 input2 output2.
Codec context input1 output1
-> Codec context input2 output2
-> Codec context (Either input1 input2) (Either output1 output2)
eitherCodec (Text -> Codec Object Arch Arch
forall output. HasCodec output => Text -> ObjectCodec output output
requiredField' Text
"arch") (Codec
   Object
   (Either FlagName (CompilerFlavor, VersionRange))
   (Either FlagName (CompilerFlavor, VersionRange))
 -> Codec
      Object
      (Either Arch (Either FlagName (CompilerFlavor, VersionRange)))
      (Either Arch (Either FlagName (CompilerFlavor, VersionRange))))
-> Codec
     Object
     (Either FlagName (CompilerFlavor, VersionRange))
     (Either FlagName (CompilerFlavor, VersionRange))
-> Codec
     Object
     (Either Arch (Either FlagName (CompilerFlavor, VersionRange)))
     (Either Arch (Either FlagName (CompilerFlavor, VersionRange)))
forall a b. (a -> b) -> a -> b
$
            ObjectCodec FlagName FlagName
-> ObjectCodec
     (CompilerFlavor, VersionRange) (CompilerFlavor, VersionRange)
-> Codec
     Object
     (Either FlagName (CompilerFlavor, VersionRange))
     (Either FlagName (CompilerFlavor, VersionRange))
forall context input1 output1 input2 output2.
Codec context input1 output1
-> Codec context input2 output2
-> Codec context (Either input1 input2) (Either output1 output2)
eitherCodec (Text -> ObjectCodec FlagName FlagName
forall output. HasCodec output => Text -> ObjectCodec output output
requiredField' Text
"flag") (ObjectCodec
   (CompilerFlavor, VersionRange) (CompilerFlavor, VersionRange)
 -> Codec
      Object
      (Either FlagName (CompilerFlavor, VersionRange))
      (Either FlagName (CompilerFlavor, VersionRange)))
-> ObjectCodec
     (CompilerFlavor, VersionRange) (CompilerFlavor, VersionRange)
-> Codec
     Object
     (Either FlagName (CompilerFlavor, VersionRange))
     (Either FlagName (CompilerFlavor, VersionRange))
forall a b. (a -> b) -> a -> b
$
              (,) (CompilerFlavor -> VersionRange -> (CompilerFlavor, VersionRange))
-> Codec Object (CompilerFlavor, VersionRange) CompilerFlavor
-> Codec
     Object
     (CompilerFlavor, VersionRange)
     (VersionRange -> (CompilerFlavor, VersionRange))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> ObjectCodec CompilerFlavor CompilerFlavor
forall output. HasCodec output => Text -> ObjectCodec output output
requiredField' Text
"compiler" ObjectCodec CompilerFlavor CompilerFlavor
-> ((CompilerFlavor, VersionRange) -> CompilerFlavor)
-> Codec Object (CompilerFlavor, VersionRange) CompilerFlavor
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
.= (CompilerFlavor, VersionRange) -> CompilerFlavor
forall a b. (a, b) -> a
fst Codec
  Object
  (CompilerFlavor, VersionRange)
  (VersionRange -> (CompilerFlavor, VersionRange))
-> Codec Object (CompilerFlavor, VersionRange) VersionRange
-> ObjectCodec
     (CompilerFlavor, VersionRange) (CompilerFlavor, VersionRange)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text -> ObjectCodec VersionRange VersionRange
forall output. HasCodec output => Text -> ObjectCodec output output
requiredField' Text
"version" ObjectCodec VersionRange VersionRange
-> ((CompilerFlavor, VersionRange) -> VersionRange)
-> Codec Object (CompilerFlavor, VersionRange) VersionRange
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
.= (CompilerFlavor, VersionRange) -> VersionRange
forall a b. (a, b) -> b
snd
    where
      f :: Either
  OS (Either Arch (Either FlagName (CompilerFlavor, VersionRange)))
-> ConfVar
f = \case
        Left OS
o -> OS -> ConfVar
OS OS
o
        Right (Left Arch
a) -> Arch -> ConfVar
Arch Arch
a
        Right (Right (Left FlagName
name)) -> FlagName -> ConfVar
Flag FlagName
name
        Right (Right (Right (CompilerFlavor
compiler, VersionRange
version))) -> CompilerFlavor -> VersionRange -> ConfVar
Impl CompilerFlavor
compiler VersionRange
version
      g :: ConfVar
-> Either
     OS (Either Arch (Either FlagName (CompilerFlavor, VersionRange)))
g = \case
        OS OS
o -> OS
-> Either
     OS (Either Arch (Either FlagName (CompilerFlavor, VersionRange)))
forall a b. a -> Either a b
Left OS
o
        Arch Arch
a -> Either Arch (Either FlagName (CompilerFlavor, VersionRange))
-> Either
     OS (Either Arch (Either FlagName (CompilerFlavor, VersionRange)))
forall a b. b -> Either a b
Right (Either Arch (Either FlagName (CompilerFlavor, VersionRange))
 -> Either
      OS (Either Arch (Either FlagName (CompilerFlavor, VersionRange))))
-> Either Arch (Either FlagName (CompilerFlavor, VersionRange))
-> Either
     OS (Either Arch (Either FlagName (CompilerFlavor, VersionRange)))
forall a b. (a -> b) -> a -> b
$ Arch
-> Either Arch (Either FlagName (CompilerFlavor, VersionRange))
forall a b. a -> Either a b
Left Arch
a
        Flag FlagName
name -> Either Arch (Either FlagName (CompilerFlavor, VersionRange))
-> Either
     OS (Either Arch (Either FlagName (CompilerFlavor, VersionRange)))
forall a b. b -> Either a b
Right (Either Arch (Either FlagName (CompilerFlavor, VersionRange))
 -> Either
      OS (Either Arch (Either FlagName (CompilerFlavor, VersionRange))))
-> Either Arch (Either FlagName (CompilerFlavor, VersionRange))
-> Either
     OS (Either Arch (Either FlagName (CompilerFlavor, VersionRange)))
forall a b. (a -> b) -> a -> b
$ Either FlagName (CompilerFlavor, VersionRange)
-> Either Arch (Either FlagName (CompilerFlavor, VersionRange))
forall a b. b -> Either a b
Right (Either FlagName (CompilerFlavor, VersionRange)
 -> Either Arch (Either FlagName (CompilerFlavor, VersionRange)))
-> Either FlagName (CompilerFlavor, VersionRange)
-> Either Arch (Either FlagName (CompilerFlavor, VersionRange))
forall a b. (a -> b) -> a -> b
$ FlagName -> Either FlagName (CompilerFlavor, VersionRange)
forall a b. a -> Either a b
Left FlagName
name
        Impl CompilerFlavor
compiler VersionRange
version -> Either Arch (Either FlagName (CompilerFlavor, VersionRange))
-> Either
     OS (Either Arch (Either FlagName (CompilerFlavor, VersionRange)))
forall a b. b -> Either a b
Right (Either Arch (Either FlagName (CompilerFlavor, VersionRange))
 -> Either
      OS (Either Arch (Either FlagName (CompilerFlavor, VersionRange))))
-> Either Arch (Either FlagName (CompilerFlavor, VersionRange))
-> Either
     OS (Either Arch (Either FlagName (CompilerFlavor, VersionRange)))
forall a b. (a -> b) -> a -> b
$ Either FlagName (CompilerFlavor, VersionRange)
-> Either Arch (Either FlagName (CompilerFlavor, VersionRange))
forall a b. b -> Either a b
Right (Either FlagName (CompilerFlavor, VersionRange)
 -> Either Arch (Either FlagName (CompilerFlavor, VersionRange)))
-> Either FlagName (CompilerFlavor, VersionRange)
-> Either Arch (Either FlagName (CompilerFlavor, VersionRange))
forall a b. (a -> b) -> a -> b
$ (CompilerFlavor, VersionRange)
-> Either FlagName (CompilerFlavor, VersionRange)
forall a b. b -> Either a b
Right (CompilerFlavor
compiler, VersionRange
version)

instance HasCodec Arch where
  -- TODO add OtherArch
  codec :: JSONCodec Arch
codec =
    NonEmpty (Arch, Text) -> JSONCodec Arch
forall constant.
Eq constant =>
NonEmpty (constant, Text) -> JSONCodec constant
stringConstCodec
      [ (Arch
I386, Text
"I386"),
        (Arch
X86_64, Text
"X86_64"),
        (Arch
PPC, Text
"PPC"),
        (Arch
PPC64, Text
"PPC64"),
        (Arch
Sparc, Text
"Sparc"),
        (Arch
Arm, Text
"Arm"),
        (Arch
AArch64, Text
"AArch64"),
        (Arch
Mips, Text
"Mips"),
        (Arch
SH, Text
"SH"),
        (Arch
IA64, Text
"IA64"),
        (Arch
S390, Text
"S390"),
        (Arch
Alpha, Text
"Alpha"),
        (Arch
Hppa, Text
"Hppa"),
        (Arch
Rs6000, Text
"Rs6000"),
        (Arch
M68k, Text
"M68k"),
        (Arch
Vax, Text
"Vax"),
        (Arch
JavaScript, Text
"JavaScript")
      ]

instance HasCodec OS where
  -- TODO add OtherOS
  codec :: JSONCodec OS
codec =
    NonEmpty (OS, Text) -> JSONCodec OS
forall constant.
Eq constant =>
NonEmpty (constant, Text) -> JSONCodec constant
stringConstCodec
      [ (OS
Linux, Text
"Linux"),
        (OS
Windows, Text
"Windows"),
        (OS
OSX, Text
"OSX"),
        (OS
FreeBSD, Text
"FreeBSD"),
        (OS
OpenBSD, Text
"OpenBSD"),
        (OS
NetBSD, Text
"NetBSD"),
        (OS
DragonFly, Text
"DragonFly"),
        (OS
Solaris, Text
"Solaris"),
        (OS
AIX, Text
"AIX"),
        (OS
HPUX, Text
"HPUX"),
        (OS
IRIX, Text
"IRIX"),
        (OS
HaLVM, Text
"HaLVM"),
        (OS
Hurd, Text
"Hurd"),
        (OS
IOS, Text
"IOS"),
        (OS
Android, Text
"Android"),
        (OS
Ghcjs, Text
"Ghcjs")
      ]

instance HasCodec Library where
  codec :: JSONCodec Library
codec =
    Text -> ObjectCodec Library Library -> JSONCodec Library
forall input output.
Text -> ObjectCodec input output -> ValueCodec input output
object Text
"Library" (ObjectCodec Library Library -> JSONCodec Library)
-> ObjectCodec Library Library -> JSONCodec Library
forall a b. (a -> b) -> a -> b
$
      LibraryName
-> [ModuleName]
-> [ModuleReexport]
-> [ModuleName]
-> Bool
-> LibraryVisibility
-> BuildInfo
-> Library
Library
        (LibraryName
 -> [ModuleName]
 -> [ModuleReexport]
 -> [ModuleName]
 -> Bool
 -> LibraryVisibility
 -> BuildInfo
 -> Library)
-> Codec Object Library LibraryName
-> Codec
     Object
     Library
     ([ModuleName]
      -> [ModuleReexport]
      -> [ModuleName]
      -> Bool
      -> LibraryVisibility
      -> BuildInfo
      -> Library)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> ObjectCodec LibraryName LibraryName
forall output. HasCodec output => Text -> ObjectCodec output output
requiredField' Text
"name" ObjectCodec LibraryName LibraryName
-> (Library -> LibraryName) -> Codec Object Library LibraryName
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
.= Library -> LibraryName
libName
        Codec
  Object
  Library
  ([ModuleName]
   -> [ModuleReexport]
   -> [ModuleName]
   -> Bool
   -> LibraryVisibility
   -> BuildInfo
   -> Library)
-> Codec Object Library [ModuleName]
-> Codec
     Object
     Library
     ([ModuleReexport]
      -> [ModuleName]
      -> Bool
      -> LibraryVisibility
      -> BuildInfo
      -> Library)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text -> ObjectCodec [ModuleName] [ModuleName]
forall output. HasCodec output => Text -> ObjectCodec output output
requiredField' Text
"exposed-modules" ObjectCodec [ModuleName] [ModuleName]
-> (Library -> [ModuleName]) -> Codec Object Library [ModuleName]
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
.= Library -> [ModuleName]
exposedModules
        Codec
  Object
  Library
  ([ModuleReexport]
   -> [ModuleName]
   -> Bool
   -> LibraryVisibility
   -> BuildInfo
   -> Library)
-> Codec Object Library [ModuleReexport]
-> Codec
     Object
     Library
     ([ModuleName] -> Bool -> LibraryVisibility -> BuildInfo -> Library)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text -> ObjectCodec [ModuleReexport] [ModuleReexport]
forall output. HasCodec output => Text -> ObjectCodec output output
requiredField' Text
"re-exported-modules" ObjectCodec [ModuleReexport] [ModuleReexport]
-> (Library -> [ModuleReexport])
-> Codec Object Library [ModuleReexport]
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
.= Library -> [ModuleReexport]
reexportedModules
        Codec
  Object
  Library
  ([ModuleName] -> Bool -> LibraryVisibility -> BuildInfo -> Library)
-> Codec Object Library [ModuleName]
-> Codec
     Object Library (Bool -> LibraryVisibility -> BuildInfo -> Library)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text -> ObjectCodec [ModuleName] [ModuleName]
forall output. HasCodec output => Text -> ObjectCodec output output
requiredField' Text
"signatures" ObjectCodec [ModuleName] [ModuleName]
-> (Library -> [ModuleName]) -> Codec Object Library [ModuleName]
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
.= Library -> [ModuleName]
signatures
        Codec
  Object Library (Bool -> LibraryVisibility -> BuildInfo -> Library)
-> Codec Object Library Bool
-> Codec Object Library (LibraryVisibility -> BuildInfo -> Library)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text -> ObjectCodec Bool Bool
forall output. HasCodec output => Text -> ObjectCodec output output
requiredField' Text
"exposed" ObjectCodec Bool Bool
-> (Library -> Bool) -> Codec Object Library Bool
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
.= Library -> Bool
libExposed
        Codec Object Library (LibraryVisibility -> BuildInfo -> Library)
-> Codec Object Library LibraryVisibility
-> Codec Object Library (BuildInfo -> Library)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text -> ObjectCodec LibraryVisibility LibraryVisibility
forall output. HasCodec output => Text -> ObjectCodec output output
requiredField' Text
"visibility" ObjectCodec LibraryVisibility LibraryVisibility
-> (Library -> LibraryVisibility)
-> Codec Object Library LibraryVisibility
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
.= Library -> LibraryVisibility
libVisibility
        Codec Object Library (BuildInfo -> Library)
-> Codec Object Library BuildInfo -> ObjectCodec Library Library
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text -> ObjectCodec BuildInfo BuildInfo
forall output. HasCodec output => Text -> ObjectCodec output output
requiredField' Text
"build-info" ObjectCodec BuildInfo BuildInfo
-> (Library -> BuildInfo) -> Codec Object Library BuildInfo
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
.= Library -> BuildInfo
libBuildInfo

instance HasCodec LibraryName where
  codec :: JSONCodec LibraryName
codec =
    Text
-> ObjectCodec LibraryName LibraryName -> JSONCodec LibraryName
forall input output.
Text -> ObjectCodec input output -> ValueCodec input output
object Text
"LibraryName" (ObjectCodec LibraryName LibraryName -> JSONCodec LibraryName)
-> ObjectCodec LibraryName LibraryName -> JSONCodec LibraryName
forall a b. (a -> b) -> a -> b
$
      (Either LibraryName UnqualComponentName -> LibraryName)
-> (LibraryName -> Either () UnqualComponentName)
-> Codec
     Object
     (Either () UnqualComponentName)
     (Either LibraryName UnqualComponentName)
-> ObjectCodec LibraryName LibraryName
forall oldOutput newOutput newInput oldInput context.
(oldOutput -> newOutput)
-> (newInput -> oldInput)
-> Codec context oldInput oldOutput
-> Codec context newInput newOutput
dimapCodec Either LibraryName UnqualComponentName -> LibraryName
forall a. Either a UnqualComponentName -> LibraryName
f LibraryName -> Either () UnqualComponentName
g (Codec
   Object
   (Either () UnqualComponentName)
   (Either LibraryName UnqualComponentName)
 -> ObjectCodec LibraryName LibraryName)
-> Codec
     Object
     (Either () UnqualComponentName)
     (Either LibraryName UnqualComponentName)
-> ObjectCodec LibraryName LibraryName
forall a b. (a -> b) -> a -> b
$
        Codec Object () LibraryName
-> Codec Object UnqualComponentName UnqualComponentName
-> Codec
     Object
     (Either () UnqualComponentName)
     (Either LibraryName UnqualComponentName)
forall context input1 output1 input2 output2.
Codec context input1 output1
-> Codec context input2 output2
-> Codec context (Either input1 input2) (Either output1 output2)
eitherCodec (LibraryName -> Codec Object () LibraryName
forall (f :: * -> *) a. Applicative f => a -> f a
pure LibraryName
LMainLibName) (Codec Object UnqualComponentName UnqualComponentName
 -> Codec
      Object
      (Either () UnqualComponentName)
      (Either LibraryName UnqualComponentName))
-> Codec Object UnqualComponentName UnqualComponentName
-> Codec
     Object
     (Either () UnqualComponentName)
     (Either LibraryName UnqualComponentName)
forall a b. (a -> b) -> a -> b
$
          Text -> Codec Object UnqualComponentName UnqualComponentName
forall output. HasCodec output => Text -> ObjectCodec output output
requiredField' Text
"sub-lib-name"
    where
      f :: Either a UnqualComponentName -> LibraryName
f = \case
        Left a
_ -> LibraryName
LMainLibName
        Right UnqualComponentName
s -> UnqualComponentName -> LibraryName
LSubLibName UnqualComponentName
s
      g :: LibraryName -> Either () UnqualComponentName
g = \case
        LibraryName
LMainLibName -> () -> Either () UnqualComponentName
forall a b. a -> Either a b
Left ()
        LSubLibName UnqualComponentName
s -> UnqualComponentName -> Either () UnqualComponentName
forall a b. b -> Either a b
Right UnqualComponentName
s

instance HasCodec ModuleName where
  codec :: JSONCodec ModuleName
codec = ([String] -> ModuleName)
-> (ModuleName -> [String])
-> Codec Value [String] [String]
-> JSONCodec ModuleName
forall oldOutput newOutput newInput oldInput context.
(oldOutput -> newOutput)
-> (newInput -> oldInput)
-> Codec context oldInput oldOutput
-> Codec context newInput newOutput
dimapCodec [String] -> ModuleName
fromComponents ModuleName -> [String]
components Codec Value [String] [String]
forall value. HasCodec value => JSONCodec value
codec

instance HasCodec ModuleReexport where
  codec :: JSONCodec ModuleReexport
codec =
    Text
-> ObjectCodec ModuleReexport ModuleReexport
-> JSONCodec ModuleReexport
forall input output.
Text -> ObjectCodec input output -> ValueCodec input output
object Text
"ModuleReexport" (ObjectCodec ModuleReexport ModuleReexport
 -> JSONCodec ModuleReexport)
-> ObjectCodec ModuleReexport ModuleReexport
-> JSONCodec ModuleReexport
forall a b. (a -> b) -> a -> b
$
      Maybe PackageName -> ModuleName -> ModuleName -> ModuleReexport
ModuleReexport
        (Maybe PackageName -> ModuleName -> ModuleName -> ModuleReexport)
-> Codec Object ModuleReexport (Maybe PackageName)
-> Codec
     Object ModuleReexport (ModuleName -> ModuleName -> ModuleReexport)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> ObjectCodec (Maybe PackageName) (Maybe PackageName)
forall output. HasCodec output => Text -> ObjectCodec output output
requiredField' Text
"moduleReexportOriginalPackage" ObjectCodec (Maybe PackageName) (Maybe PackageName)
-> (ModuleReexport -> Maybe PackageName)
-> Codec Object ModuleReexport (Maybe PackageName)
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
.= ModuleReexport -> Maybe PackageName
moduleReexportOriginalPackage
        Codec
  Object ModuleReexport (ModuleName -> ModuleName -> ModuleReexport)
-> Codec Object ModuleReexport ModuleName
-> Codec Object ModuleReexport (ModuleName -> ModuleReexport)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text -> ObjectCodec ModuleName ModuleName
forall output. HasCodec output => Text -> ObjectCodec output output
requiredField' Text
"moduleReexportOriginalName" ObjectCodec ModuleName ModuleName
-> (ModuleReexport -> ModuleName)
-> Codec Object ModuleReexport ModuleName
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
.= ModuleReexport -> ModuleName
moduleReexportOriginalName
        Codec Object ModuleReexport (ModuleName -> ModuleReexport)
-> Codec Object ModuleReexport ModuleName
-> ObjectCodec ModuleReexport ModuleReexport
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text -> ObjectCodec ModuleName ModuleName
forall output. HasCodec output => Text -> ObjectCodec output output
requiredField' Text
"moduleReexportName" ObjectCodec ModuleName ModuleName
-> (ModuleReexport -> ModuleName)
-> Codec Object ModuleReexport ModuleName
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
.= ModuleReexport -> ModuleName
moduleReexportName

instance HasCodec LibraryVisibility where
  codec :: JSONCodec LibraryVisibility
codec = NonEmpty (LibraryVisibility, Text) -> JSONCodec LibraryVisibility
forall constant.
Eq constant =>
NonEmpty (constant, Text) -> JSONCodec constant
stringConstCodec [(LibraryVisibility
LibraryVisibilityPublic, Text
"LibraryVisibilityPublic"), (LibraryVisibility
LibraryVisibilityPrivate, Text
"LibraryVisibilityPrivate")]

instance HasCodec ForeignLib where
  codec :: JSONCodec ForeignLib
codec =
    Text -> ObjectCodec ForeignLib ForeignLib -> JSONCodec ForeignLib
forall input output.
Text -> ObjectCodec input output -> ValueCodec input output
object Text
"ForeignLib" (ObjectCodec ForeignLib ForeignLib -> JSONCodec ForeignLib)
-> ObjectCodec ForeignLib ForeignLib -> JSONCodec ForeignLib
forall a b. (a -> b) -> a -> b
$
      UnqualComponentName
-> ForeignLibType
-> [ForeignLibOption]
-> BuildInfo
-> Maybe LibVersionInfo
-> Maybe Version
-> [String]
-> ForeignLib
ForeignLib
        (UnqualComponentName
 -> ForeignLibType
 -> [ForeignLibOption]
 -> BuildInfo
 -> Maybe LibVersionInfo
 -> Maybe Version
 -> [String]
 -> ForeignLib)
-> Codec Object ForeignLib UnqualComponentName
-> Codec
     Object
     ForeignLib
     (ForeignLibType
      -> [ForeignLibOption]
      -> BuildInfo
      -> Maybe LibVersionInfo
      -> Maybe Version
      -> [String]
      -> ForeignLib)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Codec Object UnqualComponentName UnqualComponentName
forall output. HasCodec output => Text -> ObjectCodec output output
requiredField' Text
"name" Codec Object UnqualComponentName UnqualComponentName
-> (ForeignLib -> UnqualComponentName)
-> Codec Object ForeignLib UnqualComponentName
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
.= ForeignLib -> UnqualComponentName
foreignLibName
        Codec
  Object
  ForeignLib
  (ForeignLibType
   -> [ForeignLibOption]
   -> BuildInfo
   -> Maybe LibVersionInfo
   -> Maybe Version
   -> [String]
   -> ForeignLib)
-> Codec Object ForeignLib ForeignLibType
-> Codec
     Object
     ForeignLib
     ([ForeignLibOption]
      -> BuildInfo
      -> Maybe LibVersionInfo
      -> Maybe Version
      -> [String]
      -> ForeignLib)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text -> ObjectCodec ForeignLibType ForeignLibType
forall output. HasCodec output => Text -> ObjectCodec output output
requiredField' Text
"type" ObjectCodec ForeignLibType ForeignLibType
-> (ForeignLib -> ForeignLibType)
-> Codec Object ForeignLib ForeignLibType
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
.= ForeignLib -> ForeignLibType
foreignLibType
        Codec
  Object
  ForeignLib
  ([ForeignLibOption]
   -> BuildInfo
   -> Maybe LibVersionInfo
   -> Maybe Version
   -> [String]
   -> ForeignLib)
-> Codec Object ForeignLib [ForeignLibOption]
-> Codec
     Object
     ForeignLib
     (BuildInfo
      -> Maybe LibVersionInfo -> Maybe Version -> [String] -> ForeignLib)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text -> ObjectCodec [ForeignLibOption] [ForeignLibOption]
forall output. HasCodec output => Text -> ObjectCodec output output
requiredField' Text
"options" ObjectCodec [ForeignLibOption] [ForeignLibOption]
-> (ForeignLib -> [ForeignLibOption])
-> Codec Object ForeignLib [ForeignLibOption]
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
.= ForeignLib -> [ForeignLibOption]
foreignLibOptions
        Codec
  Object
  ForeignLib
  (BuildInfo
   -> Maybe LibVersionInfo -> Maybe Version -> [String] -> ForeignLib)
-> Codec Object ForeignLib BuildInfo
-> Codec
     Object
     ForeignLib
     (Maybe LibVersionInfo -> Maybe Version -> [String] -> ForeignLib)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text -> ObjectCodec BuildInfo BuildInfo
forall output. HasCodec output => Text -> ObjectCodec output output
requiredField' Text
"build-info" ObjectCodec BuildInfo BuildInfo
-> (ForeignLib -> BuildInfo) -> Codec Object ForeignLib BuildInfo
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
.= ForeignLib -> BuildInfo
foreignLibBuildInfo
        Codec
  Object
  ForeignLib
  (Maybe LibVersionInfo -> Maybe Version -> [String] -> ForeignLib)
-> Codec Object ForeignLib (Maybe LibVersionInfo)
-> Codec
     Object ForeignLib (Maybe Version -> [String] -> ForeignLib)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text -> ObjectCodec (Maybe LibVersionInfo) (Maybe LibVersionInfo)
forall output. HasCodec output => Text -> ObjectCodec output output
requiredField' Text
"version-info" ObjectCodec (Maybe LibVersionInfo) (Maybe LibVersionInfo)
-> (ForeignLib -> Maybe LibVersionInfo)
-> Codec Object ForeignLib (Maybe LibVersionInfo)
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
.= ForeignLib -> Maybe LibVersionInfo
foreignLibVersionInfo
        Codec Object ForeignLib (Maybe Version -> [String] -> ForeignLib)
-> Codec Object ForeignLib (Maybe Version)
-> Codec Object ForeignLib ([String] -> ForeignLib)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text -> ObjectCodec (Maybe Version) (Maybe Version)
forall output. HasCodec output => Text -> ObjectCodec output output
requiredField' Text
"linux-version" ObjectCodec (Maybe Version) (Maybe Version)
-> (ForeignLib -> Maybe Version)
-> Codec Object ForeignLib (Maybe Version)
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
.= ForeignLib -> Maybe Version
foreignLibVersionLinux
        Codec Object ForeignLib ([String] -> ForeignLib)
-> Codec Object ForeignLib [String]
-> ObjectCodec ForeignLib ForeignLib
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text -> ObjectCodec [String] [String]
forall output. HasCodec output => Text -> ObjectCodec output output
requiredField' Text
"mod-def-files" ObjectCodec [String] [String]
-> (ForeignLib -> [String]) -> Codec Object ForeignLib [String]
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
.= ForeignLib -> [String]
foreignLibModDefFile

instance HasCodec ForeignLibType where
  codec :: JSONCodec ForeignLibType
codec = NonEmpty (ForeignLibType, Text) -> JSONCodec ForeignLibType
forall constant.
Eq constant =>
NonEmpty (constant, Text) -> JSONCodec constant
stringConstCodec [(ForeignLibType
ForeignLibNativeShared, Text
"ForeignLibNativeShared"), (ForeignLibType
ForeignLibNativeStatic, Text
"ForeignLibNativeStatic"), (ForeignLibType
ForeignLibTypeUnknown, Text
"ForeignLibTypeUnknown")]

instance HasCodec ForeignLibOption where
  codec :: JSONCodec ForeignLibOption
codec = ForeignLibOption -> Text -> JSONCodec ForeignLibOption
forall value. value -> Text -> JSONCodec value
literalTextValueCodec ForeignLibOption
ForeignLibStandalone Text
"ForeignLibStandalone"

instance HasCodec LibVersionInfo where
  codec :: JSONCodec LibVersionInfo
codec = ((Int, Int, Int) -> LibVersionInfo)
-> (LibVersionInfo -> (Int, Int, Int))
-> Codec Value (Int, Int, Int) (Int, Int, Int)
-> JSONCodec LibVersionInfo
forall oldOutput newOutput newInput oldInput context.
(oldOutput -> newOutput)
-> (newInput -> oldInput)
-> Codec context oldInput oldOutput
-> Codec context newInput newOutput
dimapCodec (Int, Int, Int) -> LibVersionInfo
mkLibVersionInfo LibVersionInfo -> (Int, Int, Int)
libVersionInfoCRA Codec Value (Int, Int, Int) (Int, Int, Int)
forall value. HasCodec value => JSONCodec value
codec

instance HasCodec Version where
  codec :: JSONCodec Version
codec = ([Int] -> Version)
-> (Version -> [Int])
-> Codec Value [Int] [Int]
-> JSONCodec Version
forall oldOutput newOutput newInput oldInput context.
(oldOutput -> newOutput)
-> (newInput -> oldInput)
-> Codec context oldInput oldOutput
-> Codec context newInput newOutput
dimapCodec [Int] -> Version
mkVersion Version -> [Int]
versionNumbers Codec Value [Int] [Int]
forall value. HasCodec value => JSONCodec value
codec

instance HasCodec Executable where
  codec :: JSONCodec Executable
codec =
    Text -> ObjectCodec Executable Executable -> JSONCodec Executable
forall input output.
Text -> ObjectCodec input output -> ValueCodec input output
object Text
"Executable" (ObjectCodec Executable Executable -> JSONCodec Executable)
-> ObjectCodec Executable Executable -> JSONCodec Executable
forall a b. (a -> b) -> a -> b
$
      UnqualComponentName
-> String -> ExecutableScope -> BuildInfo -> Executable
Executable
        (UnqualComponentName
 -> String -> ExecutableScope -> BuildInfo -> Executable)
-> Codec Object Executable UnqualComponentName
-> Codec
     Object
     Executable
     (String -> ExecutableScope -> BuildInfo -> Executable)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Codec Object UnqualComponentName UnqualComponentName
forall output. HasCodec output => Text -> ObjectCodec output output
requiredField' Text
"name" Codec Object UnqualComponentName UnqualComponentName
-> (Executable -> UnqualComponentName)
-> Codec Object Executable UnqualComponentName
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
.= Executable -> UnqualComponentName
exeName
        Codec
  Object
  Executable
  (String -> ExecutableScope -> BuildInfo -> Executable)
-> Codec Object Executable String
-> Codec
     Object Executable (ExecutableScope -> BuildInfo -> Executable)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text -> ObjectCodec String String
forall output. HasCodec output => Text -> ObjectCodec output output
requiredField' Text
"module-path" ObjectCodec String String
-> (Executable -> String) -> Codec Object Executable String
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
.= Executable -> String
modulePath
        Codec
  Object Executable (ExecutableScope -> BuildInfo -> Executable)
-> Codec Object Executable ExecutableScope
-> Codec Object Executable (BuildInfo -> Executable)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text -> ObjectCodec ExecutableScope ExecutableScope
forall output. HasCodec output => Text -> ObjectCodec output output
requiredField' Text
"scope" ObjectCodec ExecutableScope ExecutableScope
-> (Executable -> ExecutableScope)
-> Codec Object Executable ExecutableScope
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
.= Executable -> ExecutableScope
exeScope
        Codec Object Executable (BuildInfo -> Executable)
-> Codec Object Executable BuildInfo
-> ObjectCodec Executable Executable
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text -> ObjectCodec BuildInfo BuildInfo
forall output. HasCodec output => Text -> ObjectCodec output output
requiredField' Text
"build-info" ObjectCodec BuildInfo BuildInfo
-> (Executable -> BuildInfo) -> Codec Object Executable BuildInfo
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
.= Executable -> BuildInfo
buildInfo

instance HasCodec ExecutableScope where
  codec :: JSONCodec ExecutableScope
codec =
    NonEmpty (ExecutableScope, Text) -> JSONCodec ExecutableScope
forall constant.
Eq constant =>
NonEmpty (constant, Text) -> JSONCodec constant
stringConstCodec (NonEmpty (ExecutableScope, Text) -> JSONCodec ExecutableScope)
-> NonEmpty (ExecutableScope, Text) -> JSONCodec ExecutableScope
forall a b. (a -> b) -> a -> b
$
      [(ExecutableScope, Text)] -> NonEmpty (ExecutableScope, Text)
forall a. [a] -> NonEmpty a
NE.fromList
        [ (ExecutableScope
ExecutablePublic, Text
"public"),
          (ExecutableScope
ExecutablePrivate, Text
"private")
        ]

instance HasCodec TestSuite where
  codec :: JSONCodec TestSuite
codec =
    Text -> ObjectCodec TestSuite TestSuite -> JSONCodec TestSuite
forall input output.
Text -> ObjectCodec input output -> ValueCodec input output
object Text
"TestSuite" (ObjectCodec TestSuite TestSuite -> JSONCodec TestSuite)
-> ObjectCodec TestSuite TestSuite -> JSONCodec TestSuite
forall a b. (a -> b) -> a -> b
$
      UnqualComponentName -> TestSuiteInterface -> BuildInfo -> TestSuite
TestSuite
        (UnqualComponentName
 -> TestSuiteInterface -> BuildInfo -> TestSuite)
-> Codec Object TestSuite UnqualComponentName
-> Codec
     Object TestSuite (TestSuiteInterface -> BuildInfo -> TestSuite)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Codec Object UnqualComponentName UnqualComponentName
forall output. HasCodec output => Text -> ObjectCodec output output
requiredField' Text
"name" Codec Object UnqualComponentName UnqualComponentName
-> (TestSuite -> UnqualComponentName)
-> Codec Object TestSuite UnqualComponentName
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
.= TestSuite -> UnqualComponentName
testName
        Codec
  Object TestSuite (TestSuiteInterface -> BuildInfo -> TestSuite)
-> Codec Object TestSuite TestSuiteInterface
-> Codec Object TestSuite (BuildInfo -> TestSuite)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text -> ObjectCodec TestSuiteInterface TestSuiteInterface
forall output. HasCodec output => Text -> ObjectCodec output output
requiredField' Text
"interface" ObjectCodec TestSuiteInterface TestSuiteInterface
-> (TestSuite -> TestSuiteInterface)
-> Codec Object TestSuite TestSuiteInterface
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
.= TestSuite -> TestSuiteInterface
testInterface
        Codec Object TestSuite (BuildInfo -> TestSuite)
-> Codec Object TestSuite BuildInfo
-> ObjectCodec TestSuite TestSuite
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text -> ObjectCodec BuildInfo BuildInfo
forall output. HasCodec output => Text -> ObjectCodec output output
requiredField' Text
"build-info" ObjectCodec BuildInfo BuildInfo
-> (TestSuite -> BuildInfo) -> Codec Object TestSuite BuildInfo
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
.= TestSuite -> BuildInfo
testBuildInfo

instance HasCodec TestSuiteInterface where
  codec :: JSONCodec TestSuiteInterface
codec =
    Text
-> ObjectCodec TestSuiteInterface TestSuiteInterface
-> JSONCodec TestSuiteInterface
forall input output.
Text -> ObjectCodec input output -> ValueCodec input output
object Text
"TestSuiteInterface" (ObjectCodec TestSuiteInterface TestSuiteInterface
 -> JSONCodec TestSuiteInterface)
-> ObjectCodec TestSuiteInterface TestSuiteInterface
-> JSONCodec TestSuiteInterface
forall a b. (a -> b) -> a -> b
$
      (Either (Version, String) (Either (Version, ModuleName) TestType)
 -> TestSuiteInterface)
-> (TestSuiteInterface
    -> Either
         (Version, String) (Either (Version, ModuleName) TestType))
-> Codec
     Object
     (Either (Version, String) (Either (Version, ModuleName) TestType))
     (Either (Version, String) (Either (Version, ModuleName) TestType))
-> ObjectCodec TestSuiteInterface TestSuiteInterface
forall oldOutput newOutput newInput oldInput context.
(oldOutput -> newOutput)
-> (newInput -> oldInput)
-> Codec context oldInput oldOutput
-> Codec context newInput newOutput
dimapCodec Either (Version, String) (Either (Version, ModuleName) TestType)
-> TestSuiteInterface
f TestSuiteInterface
-> Either (Version, String) (Either (Version, ModuleName) TestType)
g (Codec
   Object
   (Either (Version, String) (Either (Version, ModuleName) TestType))
   (Either (Version, String) (Either (Version, ModuleName) TestType))
 -> ObjectCodec TestSuiteInterface TestSuiteInterface)
-> Codec
     Object
     (Either (Version, String) (Either (Version, ModuleName) TestType))
     (Either (Version, String) (Either (Version, ModuleName) TestType))
-> ObjectCodec TestSuiteInterface TestSuiteInterface
forall a b. (a -> b) -> a -> b
$
        Codec Object (Version, String) (Version, String)
-> Codec
     Object
     (Either (Version, ModuleName) TestType)
     (Either (Version, ModuleName) TestType)
-> Codec
     Object
     (Either (Version, String) (Either (Version, ModuleName) TestType))
     (Either (Version, String) (Either (Version, ModuleName) TestType))
forall context input1 output1 input2 output2.
Codec context input1 output1
-> Codec context input2 output2
-> Codec context (Either input1 input2) (Either output1 output2)
eitherCodec ((,) (Version -> String -> (Version, String))
-> Codec Object (Version, String) Version
-> Codec Object (Version, String) (String -> (Version, String))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> ObjectCodec Version Version
forall output. HasCodec output => Text -> ObjectCodec output output
requiredField' Text
"version" ObjectCodec Version Version
-> ((Version, String) -> Version)
-> Codec Object (Version, String) Version
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
.= (Version, String) -> Version
forall a b. (a, b) -> a
fst Codec Object (Version, String) (String -> (Version, String))
-> Codec Object (Version, String) String
-> Codec Object (Version, String) (Version, String)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text -> ObjectCodec String String
forall output. HasCodec output => Text -> ObjectCodec output output
requiredField' Text
"filepath" ObjectCodec String String
-> ((Version, String) -> String)
-> Codec Object (Version, String) String
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
.= (Version, String) -> String
forall a b. (a, b) -> b
snd) (Codec
   Object
   (Either (Version, ModuleName) TestType)
   (Either (Version, ModuleName) TestType)
 -> Codec
      Object
      (Either (Version, String) (Either (Version, ModuleName) TestType))
      (Either (Version, String) (Either (Version, ModuleName) TestType)))
-> Codec
     Object
     (Either (Version, ModuleName) TestType)
     (Either (Version, ModuleName) TestType)
-> Codec
     Object
     (Either (Version, String) (Either (Version, ModuleName) TestType))
     (Either (Version, String) (Either (Version, ModuleName) TestType))
forall a b. (a -> b) -> a -> b
$
          Codec Object (Version, ModuleName) (Version, ModuleName)
-> Codec Object TestType TestType
-> Codec
     Object
     (Either (Version, ModuleName) TestType)
     (Either (Version, ModuleName) TestType)
forall context input1 output1 input2 output2.
Codec context input1 output1
-> Codec context input2 output2
-> Codec context (Either input1 input2) (Either output1 output2)
eitherCodec ((,) (Version -> ModuleName -> (Version, ModuleName))
-> Codec Object (Version, ModuleName) Version
-> Codec
     Object (Version, ModuleName) (ModuleName -> (Version, ModuleName))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> ObjectCodec Version Version
forall output. HasCodec output => Text -> ObjectCodec output output
requiredField' Text
"version" ObjectCodec Version Version
-> ((Version, ModuleName) -> Version)
-> Codec Object (Version, ModuleName) Version
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
.= (Version, ModuleName) -> Version
forall a b. (a, b) -> a
fst Codec
  Object (Version, ModuleName) (ModuleName -> (Version, ModuleName))
-> Codec Object (Version, ModuleName) ModuleName
-> Codec Object (Version, ModuleName) (Version, ModuleName)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text -> ObjectCodec ModuleName ModuleName
forall output. HasCodec output => Text -> ObjectCodec output output
requiredField' Text
"module-name" ObjectCodec ModuleName ModuleName
-> ((Version, ModuleName) -> ModuleName)
-> Codec Object (Version, ModuleName) ModuleName
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
.= (Version, ModuleName) -> ModuleName
forall a b. (a, b) -> b
snd) (Codec Object TestType TestType
 -> Codec
      Object
      (Either (Version, ModuleName) TestType)
      (Either (Version, ModuleName) TestType))
-> Codec Object TestType TestType
-> Codec
     Object
     (Either (Version, ModuleName) TestType)
     (Either (Version, ModuleName) TestType)
forall a b. (a -> b) -> a -> b
$
            Text -> Codec Object TestType TestType
forall output. HasCodec output => Text -> ObjectCodec output output
requiredField' Text
"type"
    where
      f :: Either (Version, String) (Either (Version, ModuleName) TestType)
-> TestSuiteInterface
f = \case
        Left (Version
v, String
fp) -> Version -> String -> TestSuiteInterface
TestSuiteExeV10 Version
v String
fp
        Right (Left (Version
v, ModuleName
mn)) -> Version -> ModuleName -> TestSuiteInterface
TestSuiteLibV09 Version
v ModuleName
mn
        Right (Right TestType
tt) -> TestType -> TestSuiteInterface
TestSuiteUnsupported TestType
tt
      g :: TestSuiteInterface
-> Either (Version, String) (Either (Version, ModuleName) TestType)
g = \case
        TestSuiteExeV10 Version
v String
fp -> (Version, String)
-> Either (Version, String) (Either (Version, ModuleName) TestType)
forall a b. a -> Either a b
Left (Version
v, String
fp)
        TestSuiteLibV09 Version
v ModuleName
mn -> Either (Version, ModuleName) TestType
-> Either (Version, String) (Either (Version, ModuleName) TestType)
forall a b. b -> Either a b
Right (Either (Version, ModuleName) TestType
 -> Either
      (Version, String) (Either (Version, ModuleName) TestType))
-> Either (Version, ModuleName) TestType
-> Either (Version, String) (Either (Version, ModuleName) TestType)
forall a b. (a -> b) -> a -> b
$ (Version, ModuleName) -> Either (Version, ModuleName) TestType
forall a b. a -> Either a b
Left (Version
v, ModuleName
mn)
        TestSuiteUnsupported TestType
tt -> Either (Version, ModuleName) TestType
-> Either (Version, String) (Either (Version, ModuleName) TestType)
forall a b. b -> Either a b
Right (Either (Version, ModuleName) TestType
 -> Either
      (Version, String) (Either (Version, ModuleName) TestType))
-> Either (Version, ModuleName) TestType
-> Either (Version, String) (Either (Version, ModuleName) TestType)
forall a b. (a -> b) -> a -> b
$ TestType -> Either (Version, ModuleName) TestType
forall a b. b -> Either a b
Right TestType
tt

instance HasCodec TestType where
  codec :: JSONCodec TestType
codec =
    Text -> Codec Object TestType TestType -> JSONCodec TestType
forall input output.
Text -> ObjectCodec input output -> ValueCodec input output
object Text
"TestType" (Codec Object TestType TestType -> JSONCodec TestType)
-> Codec Object TestType TestType -> JSONCodec TestType
forall a b. (a -> b) -> a -> b
$
      (Either Version (Either Version (String, Version)) -> TestType)
-> (TestType -> Either Version (Either Version (String, Version)))
-> Codec
     Object
     (Either Version (Either Version (String, Version)))
     (Either Version (Either Version (String, Version)))
-> Codec Object TestType TestType
forall oldOutput newOutput newInput oldInput context.
(oldOutput -> newOutput)
-> (newInput -> oldInput)
-> Codec context oldInput oldOutput
-> Codec context newInput newOutput
dimapCodec Either Version (Either Version (String, Version)) -> TestType
f TestType -> Either Version (Either Version (String, Version))
g (Codec
   Object
   (Either Version (Either Version (String, Version)))
   (Either Version (Either Version (String, Version)))
 -> Codec Object TestType TestType)
-> Codec
     Object
     (Either Version (Either Version (String, Version)))
     (Either Version (Either Version (String, Version)))
-> Codec Object TestType TestType
forall a b. (a -> b) -> a -> b
$
        ObjectCodec Version Version
-> Codec
     Object
     (Either Version (String, Version))
     (Either Version (String, Version))
-> Codec
     Object
     (Either Version (Either Version (String, Version)))
     (Either Version (Either Version (String, Version)))
forall context input1 output1 input2 output2.
Codec context input1 output1
-> Codec context input2 output2
-> Codec context (Either input1 input2) (Either output1 output2)
eitherCodec (Text -> ObjectCodec Version Version
forall output. HasCodec output => Text -> ObjectCodec output output
requiredField' Text
"version") (Codec
   Object
   (Either Version (String, Version))
   (Either Version (String, Version))
 -> Codec
      Object
      (Either Version (Either Version (String, Version)))
      (Either Version (Either Version (String, Version))))
-> Codec
     Object
     (Either Version (String, Version))
     (Either Version (String, Version))
-> Codec
     Object
     (Either Version (Either Version (String, Version)))
     (Either Version (Either Version (String, Version)))
forall a b. (a -> b) -> a -> b
$
          ObjectCodec Version Version
-> Codec Object (String, Version) (String, Version)
-> Codec
     Object
     (Either Version (String, Version))
     (Either Version (String, Version))
forall context input1 output1 input2 output2.
Codec context input1 output1
-> Codec context input2 output2
-> Codec context (Either input1 input2) (Either output1 output2)
eitherCodec (Text -> ObjectCodec Version Version
forall output. HasCodec output => Text -> ObjectCodec output output
requiredField' Text
"version") (Codec Object (String, Version) (String, Version)
 -> Codec
      Object
      (Either Version (String, Version))
      (Either Version (String, Version)))
-> Codec Object (String, Version) (String, Version)
-> Codec
     Object
     (Either Version (String, Version))
     (Either Version (String, Version))
forall a b. (a -> b) -> a -> b
$
            (,) (String -> Version -> (String, Version))
-> Codec Object (String, Version) String
-> Codec Object (String, Version) (Version -> (String, Version))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> ObjectCodec String String
forall output. HasCodec output => Text -> ObjectCodec output output
requiredField' Text
"name" ObjectCodec String String
-> ((String, Version) -> String)
-> Codec Object (String, Version) String
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
.= (String, Version) -> String
forall a b. (a, b) -> a
fst Codec Object (String, Version) (Version -> (String, Version))
-> Codec Object (String, Version) Version
-> Codec Object (String, Version) (String, Version)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text -> ObjectCodec Version Version
forall output. HasCodec output => Text -> ObjectCodec output output
requiredField' Text
"version" ObjectCodec Version Version
-> ((String, Version) -> Version)
-> Codec Object (String, Version) Version
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
.= (String, Version) -> Version
forall a b. (a, b) -> b
snd
    where
      f :: Either Version (Either Version (String, Version)) -> TestType
f = \case
        Left Version
v -> Version -> TestType
TestTypeExe Version
v
        Right (Left Version
v) -> Version -> TestType
TestTypeLib Version
v
        Right (Right (String
s, Version
v)) -> String -> Version -> TestType
TestTypeUnknown String
s Version
v
      g :: TestType -> Either Version (Either Version (String, Version))
g = \case
        TestTypeExe Version
v -> Version -> Either Version (Either Version (String, Version))
forall a b. a -> Either a b
Left Version
v
        TestTypeLib Version
v -> Either Version (String, Version)
-> Either Version (Either Version (String, Version))
forall a b. b -> Either a b
Right (Either Version (String, Version)
 -> Either Version (Either Version (String, Version)))
-> Either Version (String, Version)
-> Either Version (Either Version (String, Version))
forall a b. (a -> b) -> a -> b
$ Version -> Either Version (String, Version)
forall a b. a -> Either a b
Left Version
v
        TestTypeUnknown String
s Version
v -> Either Version (String, Version)
-> Either Version (Either Version (String, Version))
forall a b. b -> Either a b
Right (Either Version (String, Version)
 -> Either Version (Either Version (String, Version)))
-> Either Version (String, Version)
-> Either Version (Either Version (String, Version))
forall a b. (a -> b) -> a -> b
$ (String, Version) -> Either Version (String, Version)
forall a b. b -> Either a b
Right (String
s, Version
v)

instance HasCodec Benchmark where
  codec :: JSONCodec Benchmark
codec =
    Text -> ObjectCodec Benchmark Benchmark -> JSONCodec Benchmark
forall input output.
Text -> ObjectCodec input output -> ValueCodec input output
object Text
"Benchmark" (ObjectCodec Benchmark Benchmark -> JSONCodec Benchmark)
-> ObjectCodec Benchmark Benchmark -> JSONCodec Benchmark
forall a b. (a -> b) -> a -> b
$
      UnqualComponentName -> BenchmarkInterface -> BuildInfo -> Benchmark
Benchmark
        (UnqualComponentName
 -> BenchmarkInterface -> BuildInfo -> Benchmark)
-> Codec Object Benchmark UnqualComponentName
-> Codec
     Object Benchmark (BenchmarkInterface -> BuildInfo -> Benchmark)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Codec Object UnqualComponentName UnqualComponentName
forall output. HasCodec output => Text -> ObjectCodec output output
requiredField' Text
"name" Codec Object UnqualComponentName UnqualComponentName
-> (Benchmark -> UnqualComponentName)
-> Codec Object Benchmark UnqualComponentName
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
.= Benchmark -> UnqualComponentName
benchmarkName
        Codec
  Object Benchmark (BenchmarkInterface -> BuildInfo -> Benchmark)
-> Codec Object Benchmark BenchmarkInterface
-> Codec Object Benchmark (BuildInfo -> Benchmark)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text -> ObjectCodec BenchmarkInterface BenchmarkInterface
forall output. HasCodec output => Text -> ObjectCodec output output
requiredField' Text
"interface" ObjectCodec BenchmarkInterface BenchmarkInterface
-> (Benchmark -> BenchmarkInterface)
-> Codec Object Benchmark BenchmarkInterface
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
.= Benchmark -> BenchmarkInterface
benchmarkInterface
        Codec Object Benchmark (BuildInfo -> Benchmark)
-> Codec Object Benchmark BuildInfo
-> ObjectCodec Benchmark Benchmark
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text -> ObjectCodec BuildInfo BuildInfo
forall output. HasCodec output => Text -> ObjectCodec output output
requiredField' Text
"build-info" ObjectCodec BuildInfo BuildInfo
-> (Benchmark -> BuildInfo) -> Codec Object Benchmark BuildInfo
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
.= Benchmark -> BuildInfo
benchmarkBuildInfo

instance HasCodec BenchmarkType where
  codec :: JSONCodec BenchmarkType
codec =
    Text
-> ObjectCodec BenchmarkType BenchmarkType
-> JSONCodec BenchmarkType
forall input output.
Text -> ObjectCodec input output -> ValueCodec input output
object Text
"BenchmarkType" (ObjectCodec BenchmarkType BenchmarkType
 -> JSONCodec BenchmarkType)
-> ObjectCodec BenchmarkType BenchmarkType
-> JSONCodec BenchmarkType
forall a b. (a -> b) -> a -> b
$
      (Either Version (String, Version) -> BenchmarkType)
-> (BenchmarkType -> Either Version (String, Version))
-> Codec
     Object
     (Either Version (String, Version))
     (Either Version (String, Version))
-> ObjectCodec BenchmarkType BenchmarkType
forall oldOutput newOutput newInput oldInput context.
(oldOutput -> newOutput)
-> (newInput -> oldInput)
-> Codec context oldInput oldOutput
-> Codec context newInput newOutput
dimapCodec Either Version (String, Version) -> BenchmarkType
f BenchmarkType -> Either Version (String, Version)
g (Codec
   Object
   (Either Version (String, Version))
   (Either Version (String, Version))
 -> ObjectCodec BenchmarkType BenchmarkType)
-> Codec
     Object
     (Either Version (String, Version))
     (Either Version (String, Version))
-> ObjectCodec BenchmarkType BenchmarkType
forall a b. (a -> b) -> a -> b
$
        ObjectCodec Version Version
-> Codec Object (String, Version) (String, Version)
-> Codec
     Object
     (Either Version (String, Version))
     (Either Version (String, Version))
forall context input1 output1 input2 output2.
Codec context input1 output1
-> Codec context input2 output2
-> Codec context (Either input1 input2) (Either output1 output2)
eitherCodec (Text -> ObjectCodec Version Version
forall output. HasCodec output => Text -> ObjectCodec output output
requiredField' Text
"benchmark-type") (Codec Object (String, Version) (String, Version)
 -> Codec
      Object
      (Either Version (String, Version))
      (Either Version (String, Version)))
-> Codec Object (String, Version) (String, Version)
-> Codec
     Object
     (Either Version (String, Version))
     (Either Version (String, Version))
forall a b. (a -> b) -> a -> b
$
          (,)
            (String -> Version -> (String, Version))
-> Codec Object (String, Version) String
-> Codec Object (String, Version) (Version -> (String, Version))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> ObjectCodec String String
forall output. HasCodec output => Text -> ObjectCodec output output
requiredField' Text
"type" ObjectCodec String String
-> ((String, Version) -> String)
-> Codec Object (String, Version) String
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
.= (String, Version) -> String
forall a b. (a, b) -> a
fst
            Codec Object (String, Version) (Version -> (String, Version))
-> Codec Object (String, Version) Version
-> Codec Object (String, Version) (String, Version)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text -> ObjectCodec Version Version
forall output. HasCodec output => Text -> ObjectCodec output output
requiredField' Text
"version" ObjectCodec Version Version
-> ((String, Version) -> Version)
-> Codec Object (String, Version) Version
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
.= (String, Version) -> Version
forall a b. (a, b) -> b
snd
    where
      f :: Either Version (String, Version) -> BenchmarkType
f = \case
        Left Version
v -> Version -> BenchmarkType
BenchmarkTypeExe Version
v
        Right (String
s, Version
v) -> String -> Version -> BenchmarkType
BenchmarkTypeUnknown String
s Version
v
      g :: BenchmarkType -> Either Version (String, Version)
g = \case
        BenchmarkTypeExe Version
v -> Version -> Either Version (String, Version)
forall a b. a -> Either a b
Left Version
v
        BenchmarkTypeUnknown String
s Version
v -> (String, Version) -> Either Version (String, Version)
forall a b. b -> Either a b
Right (String
s, Version
v)

instance HasCodec BenchmarkInterface where
  codec :: JSONCodec BenchmarkInterface
codec =
    (Either (Version, String) BenchmarkType -> BenchmarkInterface)
-> (BenchmarkInterface -> Either (Version, String) BenchmarkType)
-> Codec
     Value
     (Either (Version, String) BenchmarkType)
     (Either (Version, String) BenchmarkType)
-> JSONCodec BenchmarkInterface
forall oldOutput newOutput newInput oldInput context.
(oldOutput -> newOutput)
-> (newInput -> oldInput)
-> Codec context oldInput oldOutput
-> Codec context newInput newOutput
dimapCodec Either (Version, String) BenchmarkType -> BenchmarkInterface
f BenchmarkInterface -> Either (Version, String) BenchmarkType
g (Codec
   Value
   (Either (Version, String) BenchmarkType)
   (Either (Version, String) BenchmarkType)
 -> JSONCodec BenchmarkInterface)
-> Codec
     Value
     (Either (Version, String) BenchmarkType)
     (Either (Version, String) BenchmarkType)
-> JSONCodec BenchmarkInterface
forall a b. (a -> b) -> a -> b
$
      Codec Value (Version, String) (Version, String)
-> JSONCodec BenchmarkType
-> Codec
     Value
     (Either (Version, String) BenchmarkType)
     (Either (Version, String) BenchmarkType)
forall context input1 output1 input2 output2.
Codec context input1 output1
-> Codec context input2 output2
-> Codec context (Either input1 input2) (Either output1 output2)
eitherCodec
        ( Text
-> Codec Object (Version, String) (Version, String)
-> Codec Value (Version, String) (Version, String)
forall input output.
Text -> ObjectCodec input output -> ValueCodec input output
object Text
"BenchmarkExeV10" (Codec Object (Version, String) (Version, String)
 -> Codec Value (Version, String) (Version, String))
-> Codec Object (Version, String) (Version, String)
-> Codec Value (Version, String) (Version, String)
forall a b. (a -> b) -> a -> b
$
            (,)
              (Version -> String -> (Version, String))
-> Codec Object (Version, String) Version
-> Codec Object (Version, String) (String -> (Version, String))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> ObjectCodec Version Version
forall output. HasCodec output => Text -> ObjectCodec output output
requiredField' Text
"version" ObjectCodec Version Version
-> ((Version, String) -> Version)
-> Codec Object (Version, String) Version
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
.= (Version, String) -> Version
forall a b. (a, b) -> a
fst
              Codec Object (Version, String) (String -> (Version, String))
-> Codec Object (Version, String) String
-> Codec Object (Version, String) (Version, String)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text -> ObjectCodec String String
forall output. HasCodec output => Text -> ObjectCodec output output
requiredField' Text
"filepath" ObjectCodec String String
-> ((Version, String) -> String)
-> Codec Object (Version, String) String
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
.= (Version, String) -> String
forall a b. (a, b) -> b
snd
        )
        (JSONCodec BenchmarkType
 -> Codec
      Value
      (Either (Version, String) BenchmarkType)
      (Either (Version, String) BenchmarkType))
-> JSONCodec BenchmarkType
-> Codec
     Value
     (Either (Version, String) BenchmarkType)
     (Either (Version, String) BenchmarkType)
forall a b. (a -> b) -> a -> b
$ Text
-> ObjectCodec BenchmarkType BenchmarkType
-> JSONCodec BenchmarkType
forall input output.
Text -> ObjectCodec input output -> ValueCodec input output
object Text
"BenchmarkUnsupported" (ObjectCodec BenchmarkType BenchmarkType
 -> JSONCodec BenchmarkType)
-> ObjectCodec BenchmarkType BenchmarkType
-> JSONCodec BenchmarkType
forall a b. (a -> b) -> a -> b
$ Text -> ObjectCodec BenchmarkType BenchmarkType
forall output. HasCodec output => Text -> ObjectCodec output output
requiredField' Text
"benchmark-type"
    where
      f :: Either (Version, String) BenchmarkType -> BenchmarkInterface
f = \case
        Left (Version
version, String
file) -> Version -> String -> BenchmarkInterface
BenchmarkExeV10 Version
version String
file
        Right BenchmarkType
t -> BenchmarkType -> BenchmarkInterface
BenchmarkUnsupported BenchmarkType
t
      g :: BenchmarkInterface -> Either (Version, String) BenchmarkType
g = \case
        BenchmarkExeV10 Version
version String
file -> (Version, String) -> Either (Version, String) BenchmarkType
forall a b. a -> Either a b
Left (Version
version, String
file)
        BenchmarkUnsupported BenchmarkType
t -> BenchmarkType -> Either (Version, String) BenchmarkType
forall a b. b -> Either a b
Right BenchmarkType
t

instance HasCodec ModuleRenaming where
  codec :: JSONCodec ModuleRenaming
codec =
    Text
-> ObjectCodec ModuleRenaming ModuleRenaming
-> JSONCodec ModuleRenaming
forall input output.
Text -> ObjectCodec input output -> ValueCodec input output
object Text
"ModuleRenaming" (ObjectCodec ModuleRenaming ModuleRenaming
 -> JSONCodec ModuleRenaming)
-> ObjectCodec ModuleRenaming ModuleRenaming
-> JSONCodec ModuleRenaming
forall a b. (a -> b) -> a -> b
$
      (Either
   ModuleRenaming (Either [(ModuleName, ModuleName)] [ModuleName])
 -> ModuleRenaming)
-> (ModuleRenaming
    -> Either () (Either [(ModuleName, ModuleName)] [ModuleName]))
-> Codec
     Object
     (Either () (Either [(ModuleName, ModuleName)] [ModuleName]))
     (Either
        ModuleRenaming (Either [(ModuleName, ModuleName)] [ModuleName]))
-> ObjectCodec ModuleRenaming ModuleRenaming
forall oldOutput newOutput newInput oldInput context.
(oldOutput -> newOutput)
-> (newInput -> oldInput)
-> Codec context oldInput oldOutput
-> Codec context newInput newOutput
dimapCodec Either
  ModuleRenaming (Either [(ModuleName, ModuleName)] [ModuleName])
-> ModuleRenaming
forall a.
Either a (Either [(ModuleName, ModuleName)] [ModuleName])
-> ModuleRenaming
f ModuleRenaming
-> Either () (Either [(ModuleName, ModuleName)] [ModuleName])
g (Codec
   Object
   (Either () (Either [(ModuleName, ModuleName)] [ModuleName]))
   (Either
      ModuleRenaming (Either [(ModuleName, ModuleName)] [ModuleName]))
 -> ObjectCodec ModuleRenaming ModuleRenaming)
-> Codec
     Object
     (Either () (Either [(ModuleName, ModuleName)] [ModuleName]))
     (Either
        ModuleRenaming (Either [(ModuleName, ModuleName)] [ModuleName]))
-> ObjectCodec ModuleRenaming ModuleRenaming
forall a b. (a -> b) -> a -> b
$
        Codec Object () ModuleRenaming
-> Codec
     Object
     (Either [(ModuleName, ModuleName)] [ModuleName])
     (Either [(ModuleName, ModuleName)] [ModuleName])
-> Codec
     Object
     (Either () (Either [(ModuleName, ModuleName)] [ModuleName]))
     (Either
        ModuleRenaming (Either [(ModuleName, ModuleName)] [ModuleName]))
forall context input1 output1 input2 output2.
Codec context input1 output1
-> Codec context input2 output2
-> Codec context (Either input1 input2) (Either output1 output2)
eitherCodec (ModuleRenaming -> Codec Object () ModuleRenaming
forall (f :: * -> *) a. Applicative f => a -> f a
pure ModuleRenaming
DefaultRenaming) (Codec
   Object
   (Either [(ModuleName, ModuleName)] [ModuleName])
   (Either [(ModuleName, ModuleName)] [ModuleName])
 -> Codec
      Object
      (Either () (Either [(ModuleName, ModuleName)] [ModuleName]))
      (Either
         ModuleRenaming (Either [(ModuleName, ModuleName)] [ModuleName])))
-> Codec
     Object
     (Either [(ModuleName, ModuleName)] [ModuleName])
     (Either [(ModuleName, ModuleName)] [ModuleName])
-> Codec
     Object
     (Either () (Either [(ModuleName, ModuleName)] [ModuleName]))
     (Either
        ModuleRenaming (Either [(ModuleName, ModuleName)] [ModuleName]))
forall a b. (a -> b) -> a -> b
$
          Codec Object [(ModuleName, ModuleName)] [(ModuleName, ModuleName)]
-> ObjectCodec [ModuleName] [ModuleName]
-> Codec
     Object
     (Either [(ModuleName, ModuleName)] [ModuleName])
     (Either [(ModuleName, ModuleName)] [ModuleName])
forall context input1 output1 input2 output2.
Codec context input1 output1
-> Codec context input2 output2
-> Codec context (Either input1 input2) (Either output1 output2)
eitherCodec (Text
-> Codec
     Object [(ModuleName, ModuleName)] [(ModuleName, ModuleName)]
forall output. HasCodec output => Text -> ObjectCodec output output
requiredField' Text
"name") (Text -> ObjectCodec [ModuleName] [ModuleName]
forall output. HasCodec output => Text -> ObjectCodec output output
requiredField' Text
"name")
    where
      f :: Either a (Either [(ModuleName, ModuleName)] [ModuleName])
-> ModuleRenaming
f = \case
        Left a
_ -> ModuleRenaming
DefaultRenaming
        Right (Left [(ModuleName, ModuleName)]
m) -> [(ModuleName, ModuleName)] -> ModuleRenaming
ModuleRenaming [(ModuleName, ModuleName)]
m
        Right (Right [ModuleName]
m) -> [ModuleName] -> ModuleRenaming
HidingRenaming [ModuleName]
m
      g :: ModuleRenaming
-> Either () (Either [(ModuleName, ModuleName)] [ModuleName])
g = \case
        ModuleRenaming
DefaultRenaming -> () -> Either () (Either [(ModuleName, ModuleName)] [ModuleName])
forall a b. a -> Either a b
Left ()
        ModuleRenaming [(ModuleName, ModuleName)]
m -> Either [(ModuleName, ModuleName)] [ModuleName]
-> Either () (Either [(ModuleName, ModuleName)] [ModuleName])
forall a b. b -> Either a b
Right (Either [(ModuleName, ModuleName)] [ModuleName]
 -> Either () (Either [(ModuleName, ModuleName)] [ModuleName]))
-> Either [(ModuleName, ModuleName)] [ModuleName]
-> Either () (Either [(ModuleName, ModuleName)] [ModuleName])
forall a b. (a -> b) -> a -> b
$ [(ModuleName, ModuleName)]
-> Either [(ModuleName, ModuleName)] [ModuleName]
forall a b. a -> Either a b
Left [(ModuleName, ModuleName)]
m
        HidingRenaming [ModuleName]
m -> Either [(ModuleName, ModuleName)] [ModuleName]
-> Either () (Either [(ModuleName, ModuleName)] [ModuleName])
forall a b. b -> Either a b
Right (Either [(ModuleName, ModuleName)] [ModuleName]
 -> Either () (Either [(ModuleName, ModuleName)] [ModuleName]))
-> Either [(ModuleName, ModuleName)] [ModuleName]
-> Either () (Either [(ModuleName, ModuleName)] [ModuleName])
forall a b. (a -> b) -> a -> b
$ [ModuleName] -> Either [(ModuleName, ModuleName)] [ModuleName]
forall a b. b -> Either a b
Right [ModuleName]
m

instance HasCodec IncludeRenaming where
  codec :: JSONCodec IncludeRenaming
codec =
    Text
-> ObjectCodec IncludeRenaming IncludeRenaming
-> JSONCodec IncludeRenaming
forall input output.
Text -> ObjectCodec input output -> ValueCodec input output
object Text
"IncludeRenaming" (ObjectCodec IncludeRenaming IncludeRenaming
 -> JSONCodec IncludeRenaming)
-> ObjectCodec IncludeRenaming IncludeRenaming
-> JSONCodec IncludeRenaming
forall a b. (a -> b) -> a -> b
$
      ModuleRenaming -> ModuleRenaming -> IncludeRenaming
IncludeRenaming
        (ModuleRenaming -> ModuleRenaming -> IncludeRenaming)
-> Codec Object IncludeRenaming ModuleRenaming
-> Codec Object IncludeRenaming (ModuleRenaming -> IncludeRenaming)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> ObjectCodec ModuleRenaming ModuleRenaming
forall output. HasCodec output => Text -> ObjectCodec output output
requiredField' Text
"includeProvidesRn" ObjectCodec ModuleRenaming ModuleRenaming
-> (IncludeRenaming -> ModuleRenaming)
-> Codec Object IncludeRenaming ModuleRenaming
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
.= IncludeRenaming -> ModuleRenaming
includeProvidesRn
        Codec Object IncludeRenaming (ModuleRenaming -> IncludeRenaming)
-> Codec Object IncludeRenaming ModuleRenaming
-> ObjectCodec IncludeRenaming IncludeRenaming
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text -> ObjectCodec ModuleRenaming ModuleRenaming
forall output. HasCodec output => Text -> ObjectCodec output output
requiredField' Text
"includeRequiresRn" ObjectCodec ModuleRenaming ModuleRenaming
-> (IncludeRenaming -> ModuleRenaming)
-> Codec Object IncludeRenaming ModuleRenaming
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
.= IncludeRenaming -> ModuleRenaming
includeRequiresRn

instance HasCodec Mixin where
  codec :: JSONCodec Mixin
codec =
    Text -> ObjectCodec Mixin Mixin -> JSONCodec Mixin
forall input output.
Text -> ObjectCodec input output -> ValueCodec input output
object Text
"Mixin" (ObjectCodec Mixin Mixin -> JSONCodec Mixin)
-> ObjectCodec Mixin Mixin -> JSONCodec Mixin
forall a b. (a -> b) -> a -> b
$
      PackageName -> IncludeRenaming -> Mixin
Mixin
        (PackageName -> IncludeRenaming -> Mixin)
-> Codec Object Mixin PackageName
-> Codec Object Mixin (IncludeRenaming -> Mixin)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> ObjectCodec PackageName PackageName
forall output. HasCodec output => Text -> ObjectCodec output output
requiredField' Text
"package-name" ObjectCodec PackageName PackageName
-> (Mixin -> PackageName) -> Codec Object Mixin PackageName
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
.= Mixin -> PackageName
mixinPackageName
        Codec Object Mixin (IncludeRenaming -> Mixin)
-> Codec Object Mixin IncludeRenaming -> ObjectCodec Mixin Mixin
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text -> ObjectCodec IncludeRenaming IncludeRenaming
forall output. HasCodec output => Text -> ObjectCodec output output
requiredField' Text
"include-renaming" ObjectCodec IncludeRenaming IncludeRenaming
-> (Mixin -> IncludeRenaming) -> Codec Object Mixin IncludeRenaming
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
.= Mixin -> IncludeRenaming
mixinIncludeRenaming

instance HasCodec LegacyExeDependency where
  codec :: JSONCodec LegacyExeDependency
codec =
    Text
-> ObjectCodec LegacyExeDependency LegacyExeDependency
-> JSONCodec LegacyExeDependency
forall input output.
Text -> ObjectCodec input output -> ValueCodec input output
object Text
"LegacyExeDependency" (ObjectCodec LegacyExeDependency LegacyExeDependency
 -> JSONCodec LegacyExeDependency)
-> ObjectCodec LegacyExeDependency LegacyExeDependency
-> JSONCodec LegacyExeDependency
forall a b. (a -> b) -> a -> b
$
      String -> VersionRange -> LegacyExeDependency
LegacyExeDependency
        (String -> VersionRange -> LegacyExeDependency)
-> Codec Object LegacyExeDependency String
-> Codec
     Object LegacyExeDependency (VersionRange -> LegacyExeDependency)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> ObjectCodec String String
forall output. HasCodec output => Text -> ObjectCodec output output
requiredField' Text
"package-name" ObjectCodec String String
-> (LegacyExeDependency -> String)
-> Codec Object LegacyExeDependency String
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
.= (\(LegacyExeDependency String
s VersionRange
_) -> String
s)
        Codec
  Object LegacyExeDependency (VersionRange -> LegacyExeDependency)
-> Codec Object LegacyExeDependency VersionRange
-> ObjectCodec LegacyExeDependency LegacyExeDependency
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text -> ObjectCodec VersionRange VersionRange
forall output. HasCodec output => Text -> ObjectCodec output output
requiredField' Text
"include-renaming" ObjectCodec VersionRange VersionRange
-> (LegacyExeDependency -> VersionRange)
-> Codec Object LegacyExeDependency VersionRange
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
.= (\(LegacyExeDependency String
_ VersionRange
vr) -> VersionRange
vr)

instance HasCodec ExeDependency where
  codec :: JSONCodec ExeDependency
codec =
    Text
-> ObjectCodec ExeDependency ExeDependency
-> JSONCodec ExeDependency
forall input output.
Text -> ObjectCodec input output -> ValueCodec input output
object Text
"ExeDependency" (ObjectCodec ExeDependency ExeDependency
 -> JSONCodec ExeDependency)
-> ObjectCodec ExeDependency ExeDependency
-> JSONCodec ExeDependency
forall a b. (a -> b) -> a -> b
$
      PackageName -> UnqualComponentName -> VersionRange -> ExeDependency
ExeDependency
        (PackageName
 -> UnqualComponentName -> VersionRange -> ExeDependency)
-> Codec Object ExeDependency PackageName
-> Codec
     Object
     ExeDependency
     (UnqualComponentName -> VersionRange -> ExeDependency)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> ObjectCodec PackageName PackageName
forall output. HasCodec output => Text -> ObjectCodec output output
requiredField' Text
"package-name" ObjectCodec PackageName PackageName
-> (ExeDependency -> PackageName)
-> Codec Object ExeDependency PackageName
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
.= (\(ExeDependency PackageName
a UnqualComponentName
_ VersionRange
_) -> PackageName
a)
        Codec
  Object
  ExeDependency
  (UnqualComponentName -> VersionRange -> ExeDependency)
-> Codec Object ExeDependency UnqualComponentName
-> Codec Object ExeDependency (VersionRange -> ExeDependency)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text -> Codec Object UnqualComponentName UnqualComponentName
forall output. HasCodec output => Text -> ObjectCodec output output
requiredField' Text
"executable-component-name" Codec Object UnqualComponentName UnqualComponentName
-> (ExeDependency -> UnqualComponentName)
-> Codec Object ExeDependency UnqualComponentName
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
.= (\(ExeDependency PackageName
_ UnqualComponentName
b VersionRange
_) -> UnqualComponentName
b)
        Codec Object ExeDependency (VersionRange -> ExeDependency)
-> Codec Object ExeDependency VersionRange
-> ObjectCodec ExeDependency ExeDependency
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text -> ObjectCodec VersionRange VersionRange
forall output. HasCodec output => Text -> ObjectCodec output output
requiredField' Text
"version-range" ObjectCodec VersionRange VersionRange
-> (ExeDependency -> VersionRange)
-> Codec Object ExeDependency VersionRange
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
.= (\(ExeDependency PackageName
_ UnqualComponentName
_ VersionRange
c) -> VersionRange
c)

instance HasCodec PkgconfigDependency where
  codec :: JSONCodec PkgconfigDependency
codec =
    Text
-> ObjectCodec PkgconfigDependency PkgconfigDependency
-> JSONCodec PkgconfigDependency
forall input output.
Text -> ObjectCodec input output -> ValueCodec input output
object Text
"PkgconfigDependency" (ObjectCodec PkgconfigDependency PkgconfigDependency
 -> JSONCodec PkgconfigDependency)
-> ObjectCodec PkgconfigDependency PkgconfigDependency
-> JSONCodec PkgconfigDependency
forall a b. (a -> b) -> a -> b
$
      PkgconfigName -> PkgconfigVersionRange -> PkgconfigDependency
PkgconfigDependency
        (PkgconfigName -> PkgconfigVersionRange -> PkgconfigDependency)
-> Codec Object PkgconfigDependency PkgconfigName
-> Codec
     Object
     PkgconfigDependency
     (PkgconfigVersionRange -> PkgconfigDependency)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> ObjectCodec PkgconfigName PkgconfigName
forall output. HasCodec output => Text -> ObjectCodec output output
requiredField' Text
"pkgconfigName" ObjectCodec PkgconfigName PkgconfigName
-> (PkgconfigDependency -> PkgconfigName)
-> Codec Object PkgconfigDependency PkgconfigName
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
.= (\(PkgconfigDependency PkgconfigName
name PkgconfigVersionRange
_) -> PkgconfigName
name)
        Codec
  Object
  PkgconfigDependency
  (PkgconfigVersionRange -> PkgconfigDependency)
-> Codec Object PkgconfigDependency PkgconfigVersionRange
-> ObjectCodec PkgconfigDependency PkgconfigDependency
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text -> ObjectCodec PkgconfigVersionRange PkgconfigVersionRange
forall output. HasCodec output => Text -> ObjectCodec output output
requiredField' Text
"pkgconfigVersionRange" ObjectCodec PkgconfigVersionRange PkgconfigVersionRange
-> (PkgconfigDependency -> PkgconfigVersionRange)
-> Codec Object PkgconfigDependency PkgconfigVersionRange
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
.= (\(PkgconfigDependency PkgconfigName
_ PkgconfigVersionRange
version) -> PkgconfigVersionRange
version)

instance HasCodec PkgconfigName where
  codec :: JSONCodec PkgconfigName
codec = (String -> PkgconfigName)
-> (PkgconfigName -> String)
-> Codec Value String String
-> JSONCodec PkgconfigName
forall oldOutput newOutput newInput oldInput context.
(oldOutput -> newOutput)
-> (newInput -> oldInput)
-> Codec context oldInput oldOutput
-> Codec context newInput newOutput
dimapCodec String -> PkgconfigName
mkPkgconfigName PkgconfigName -> String
unPkgconfigName Codec Value String String
forall value. HasCodec value => JSONCodec value
codec

instance HasCodec PkgconfigVersionRange where
  codec :: JSONCodec PkgconfigVersionRange
codec = (String -> Either String PkgconfigVersionRange)
-> (PkgconfigVersionRange -> String)
-> Codec Value String String
-> JSONCodec PkgconfigVersionRange
forall oldOutput newOutput newInput oldInput context.
(oldOutput -> Either String newOutput)
-> (newInput -> oldInput)
-> Codec context oldInput oldOutput
-> Codec context newInput newOutput
bimapCodec String -> Either String PkgconfigVersionRange
f PkgconfigVersionRange -> String
g Codec Value String String
forall value. HasCodec value => JSONCodec value
codec
    where
      f :: String -> Either String PkgconfigVersionRange
f = \String
s -> case String -> Either String PkgconfigVersionRange
forall a. Parsec a => String -> Either String a
eitherParsec String
s of
        Left String
pe -> String -> Either String PkgconfigVersionRange
forall a b. a -> Either a b
Left (String -> Either String PkgconfigVersionRange)
-> String -> Either String PkgconfigVersionRange
forall a b. (a -> b) -> a -> b
$ String -> String
forall a. Show a => a -> String
show String
pe
        Right PkgconfigVersionRange
a -> PkgconfigVersionRange -> Either String PkgconfigVersionRange
forall a b. b -> Either a b
Right PkgconfigVersionRange
a
      g :: PkgconfigVersionRange -> String
g = PkgconfigVersionRange -> String
forall a. Pretty a => a -> String
prettyShow

instance HasCodec PkgconfigVersion where
  codec :: JSONCodec PkgconfigVersion
codec =
    (Text -> Either String PkgconfigVersion)
-> (PkgconfigVersion -> Text)
-> Codec Value Text Text
-> JSONCodec PkgconfigVersion
forall oldOutput newOutput newInput oldInput context.
(oldOutput -> Either String newOutput)
-> (newInput -> oldInput)
-> Codec context oldInput oldOutput
-> Codec context newInput newOutput
bimapCodec
      (PkgconfigVersion -> Either String PkgconfigVersion
forall a b. b -> Either a b
Right (PkgconfigVersion -> Either String PkgconfigVersion)
-> (Text -> PkgconfigVersion)
-> Text
-> Either String PkgconfigVersion
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> PkgconfigVersion
PkgconfigVersion (ByteString -> PkgconfigVersion)
-> (Text -> ByteString) -> Text -> PkgconfigVersion
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
encodeUtf8)
      ( \(PkgconfigVersion ByteString
v) -> case ByteString -> Either UnicodeException Text
decodeUtf8' ByteString
v of
          Left UnicodeException
ex -> String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ UnicodeException -> String
forall a. Show a => a -> String
show UnicodeException
ex
          Right Text
txt -> Text
txt
      )
      Codec Value Text Text
forall value. HasCodec value => JSONCodec value
codec

instance HasCodec Language where
  codec :: JSONCodec Language
codec =
    (Either Language (Either Language String) -> Language)
-> (Language -> Either Language (Either Language String))
-> Codec
     Value
     (Either Language (Either Language String))
     (Either Language (Either Language String))
-> JSONCodec Language
forall oldOutput newOutput newInput oldInput context.
(oldOutput -> newOutput)
-> (newInput -> oldInput)
-> Codec context oldInput oldOutput
-> Codec context newInput newOutput
dimapCodec Either Language (Either Language String) -> Language
f Language -> Either Language (Either Language String)
g (Codec
   Value
   (Either Language (Either Language String))
   (Either Language (Either Language String))
 -> JSONCodec Language)
-> Codec
     Value
     (Either Language (Either Language String))
     (Either Language (Either Language String))
-> JSONCodec Language
forall a b. (a -> b) -> a -> b
$
      JSONCodec Language
-> Codec Value (Either Language String) (Either Language String)
-> Codec
     Value
     (Either Language (Either Language String))
     (Either Language (Either Language String))
forall context input1 output1 input2 output2.
Codec context input1 output1
-> Codec context input2 output2
-> Codec context (Either input1 input2) (Either output1 output2)
eitherCodec (Language -> Text -> JSONCodec Language
forall value. value -> Text -> JSONCodec value
literalTextValueCodec Language
Haskell98 Text
"Haskell98") (Codec Value (Either Language String) (Either Language String)
 -> Codec
      Value
      (Either Language (Either Language String))
      (Either Language (Either Language String)))
-> Codec Value (Either Language String) (Either Language String)
-> Codec
     Value
     (Either Language (Either Language String))
     (Either Language (Either Language String))
forall a b. (a -> b) -> a -> b
$
        JSONCodec Language
-> Codec Value String String
-> Codec Value (Either Language String) (Either Language String)
forall context input1 output1 input2 output2.
Codec context input1 output1
-> Codec context input2 output2
-> Codec context (Either input1 input2) (Either output1 output2)
eitherCodec
          (Language -> Text -> JSONCodec Language
forall value. value -> Text -> JSONCodec value
literalTextValueCodec Language
Haskell2010 Text
"Haskell2010")
          Codec Value String String
forall value. HasCodec value => JSONCodec value
codec
    where
      f :: Either Language (Either Language String) -> Language
f = \case
        Left Language
l -> Language
l
        Right (Left Language
l) -> Language
l
        Right (Right String
s) -> String -> Language
UnknownLanguage String
s
      g :: Language -> Either Language (Either Language String)
g = \case
        Language
Haskell98 -> Language -> Either Language (Either Language String)
forall a b. a -> Either a b
Left Language
Haskell98
        Language
Haskell2010 -> Either Language String -> Either Language (Either Language String)
forall a b. b -> Either a b
Right (Either Language String
 -> Either Language (Either Language String))
-> Either Language String
-> Either Language (Either Language String)
forall a b. (a -> b) -> a -> b
$ Language -> Either Language String
forall a b. a -> Either a b
Left Language
Haskell2010
        UnknownLanguage String
s -> Either Language String -> Either Language (Either Language String)
forall a b. b -> Either a b
Right (Either Language String
 -> Either Language (Either Language String))
-> Either Language String
-> Either Language (Either Language String)
forall a b. (a -> b) -> a -> b
$ String -> Either Language String
forall a b. b -> Either a b
Right String
s

instance HasCodec Extension where
  codec :: JSONCodec Extension
codec =
    Text -> JSONCodec Extension -> JSONCodec Extension
forall input output.
Text -> ValueCodec input output -> ValueCodec input output
named Text
"Extension" (JSONCodec Extension -> JSONCodec Extension)
-> JSONCodec Extension -> JSONCodec Extension
forall a b. (a -> b) -> a -> b
$
      Text -> ObjectCodec Extension Extension -> JSONCodec Extension
forall input output.
Text -> ObjectCodec input output -> ValueCodec input output
object Text
"Extension" (ObjectCodec Extension Extension -> JSONCodec Extension)
-> ObjectCodec Extension Extension -> JSONCodec Extension
forall a b. (a -> b) -> a -> b
$
        (Either KnownExtension (Either KnownExtension String) -> Extension)
-> (Extension
    -> Either KnownExtension (Either KnownExtension String))
-> Codec
     Object
     (Either KnownExtension (Either KnownExtension String))
     (Either KnownExtension (Either KnownExtension String))
-> ObjectCodec Extension Extension
forall oldOutput newOutput newInput oldInput context.
(oldOutput -> newOutput)
-> (newInput -> oldInput)
-> Codec context oldInput oldOutput
-> Codec context newInput newOutput
dimapCodec Either KnownExtension (Either KnownExtension String) -> Extension
f Extension -> Either KnownExtension (Either KnownExtension String)
g (Codec
   Object
   (Either KnownExtension (Either KnownExtension String))
   (Either KnownExtension (Either KnownExtension String))
 -> ObjectCodec Extension Extension)
-> Codec
     Object
     (Either KnownExtension (Either KnownExtension String))
     (Either KnownExtension (Either KnownExtension String))
-> ObjectCodec Extension Extension
forall a b. (a -> b) -> a -> b
$
          Codec Object KnownExtension KnownExtension
-> Codec
     Object
     (Either KnownExtension String)
     (Either KnownExtension String)
-> Codec
     Object
     (Either KnownExtension (Either KnownExtension String))
     (Either KnownExtension (Either KnownExtension String))
forall context input1 output1 input2 output2.
Codec context input1 output1
-> Codec context input2 output2
-> Codec context (Either input1 input2) (Either output1 output2)
eitherCodec (Text -> Codec Object KnownExtension KnownExtension
forall output. HasCodec output => Text -> ObjectCodec output output
requiredField' Text
"enable-extension") (Codec
   Object
   (Either KnownExtension String)
   (Either KnownExtension String)
 -> Codec
      Object
      (Either KnownExtension (Either KnownExtension String))
      (Either KnownExtension (Either KnownExtension String)))
-> Codec
     Object
     (Either KnownExtension String)
     (Either KnownExtension String)
-> Codec
     Object
     (Either KnownExtension (Either KnownExtension String))
     (Either KnownExtension (Either KnownExtension String))
forall a b. (a -> b) -> a -> b
$
            Codec Object KnownExtension KnownExtension
-> ObjectCodec String String
-> Codec
     Object
     (Either KnownExtension String)
     (Either KnownExtension String)
forall context input1 output1 input2 output2.
Codec context input1 output1
-> Codec context input2 output2
-> Codec context (Either input1 input2) (Either output1 output2)
eitherCodec
              (Text -> Codec Object KnownExtension KnownExtension
forall output. HasCodec output => Text -> ObjectCodec output output
requiredField' Text
"disable-extension")
              (Text -> ObjectCodec String String
forall output. HasCodec output => Text -> ObjectCodec output output
requiredField' Text
"unknown-extension")
    where
      f :: Either KnownExtension (Either KnownExtension String) -> Extension
f = \case
        Left KnownExtension
e -> KnownExtension -> Extension
EnableExtension KnownExtension
e
        Right (Left KnownExtension
e) -> KnownExtension -> Extension
DisableExtension KnownExtension
e
        Right (Right String
s) -> String -> Extension
UnknownExtension String
s
      g :: Extension -> Either KnownExtension (Either KnownExtension String)
g = \case
        EnableExtension KnownExtension
e -> KnownExtension
-> Either KnownExtension (Either KnownExtension String)
forall a b. a -> Either a b
Left KnownExtension
e
        DisableExtension KnownExtension
e -> Either KnownExtension String
-> Either KnownExtension (Either KnownExtension String)
forall a b. b -> Either a b
Right (Either KnownExtension String
 -> Either KnownExtension (Either KnownExtension String))
-> Either KnownExtension String
-> Either KnownExtension (Either KnownExtension String)
forall a b. (a -> b) -> a -> b
$ KnownExtension -> Either KnownExtension String
forall a b. a -> Either a b
Left KnownExtension
e
        UnknownExtension String
e -> Either KnownExtension String
-> Either KnownExtension (Either KnownExtension String)
forall a b. b -> Either a b
Right (Either KnownExtension String
 -> Either KnownExtension (Either KnownExtension String))
-> Either KnownExtension String
-> Either KnownExtension (Either KnownExtension String)
forall a b. (a -> b) -> a -> b
$ String -> Either KnownExtension String
forall a b. b -> Either a b
Right String
e

instance HasCodec KnownExtension where
  codec :: JSONCodec KnownExtension
codec = Text -> JSONCodec KnownExtension -> JSONCodec KnownExtension
forall input output.
Text -> ValueCodec input output -> ValueCodec input output
named Text
"KnownExtension" JSONCodec KnownExtension
forall enum.
(Show enum, Eq enum, Enum enum, Bounded enum) =>
JSONCodec enum
shownBoundedEnumCodec

instance HasCodec BuildInfo where
  codec :: JSONCodec BuildInfo
codec =
    Text -> ObjectCodec BuildInfo BuildInfo -> JSONCodec BuildInfo
forall input output.
Text -> ObjectCodec input output -> ValueCodec input output
object Text
"BuildInfo" (ObjectCodec BuildInfo BuildInfo -> JSONCodec BuildInfo)
-> ObjectCodec BuildInfo BuildInfo -> JSONCodec BuildInfo
forall a b. (a -> b) -> a -> b
$
      Bool
-> [LegacyExeDependency]
-> [ExeDependency]
-> [String]
-> [String]
-> [String]
-> [String]
-> [String]
-> [String]
-> [PkgconfigDependency]
-> [String]
-> [String]
-> [String]
-> [String]
-> [String]
-> [String]
-> [String]
-> [String]
-> [ModuleName]
-> [ModuleName]
-> [ModuleName]
-> Maybe Language
-> [Language]
-> [Extension]
-> [Extension]
-> [Extension]
-> [String]
-> [String]
-> [String]
-> [String]
-> [String]
-> [String]
-> [String]
-> [String]
-> [String]
-> [String]
-> PerCompilerFlavor [String]
-> PerCompilerFlavor [String]
-> PerCompilerFlavor [String]
-> PerCompilerFlavor [String]
-> [(String, String)]
-> [Dependency]
-> [Mixin]
-> BuildInfo
BuildInfo
        (Bool
 -> [LegacyExeDependency]
 -> [ExeDependency]
 -> [String]
 -> [String]
 -> [String]
 -> [String]
 -> [String]
 -> [String]
 -> [PkgconfigDependency]
 -> [String]
 -> [String]
 -> [String]
 -> [String]
 -> [String]
 -> [String]
 -> [String]
 -> [String]
 -> [ModuleName]
 -> [ModuleName]
 -> [ModuleName]
 -> Maybe Language
 -> [Language]
 -> [Extension]
 -> [Extension]
 -> [Extension]
 -> [String]
 -> [String]
 -> [String]
 -> [String]
 -> [String]
 -> [String]
 -> [String]
 -> [String]
 -> [String]
 -> [String]
 -> PerCompilerFlavor [String]
 -> PerCompilerFlavor [String]
 -> PerCompilerFlavor [String]
 -> PerCompilerFlavor [String]
 -> [(String, String)]
 -> [Dependency]
 -> [Mixin]
 -> BuildInfo)
-> Codec Object BuildInfo Bool
-> Codec
     Object
     BuildInfo
     ([LegacyExeDependency]
      -> [ExeDependency]
      -> [String]
      -> [String]
      -> [String]
      -> [String]
      -> [String]
      -> [String]
      -> [PkgconfigDependency]
      -> [String]
      -> [String]
      -> [String]
      -> [String]
      -> [String]
      -> [String]
      -> [String]
      -> [String]
      -> [ModuleName]
      -> [ModuleName]
      -> [ModuleName]
      -> Maybe Language
      -> [Language]
      -> [Extension]
      -> [Extension]
      -> [Extension]
      -> [String]
      -> [String]
      -> [String]
      -> [String]
      -> [String]
      -> [String]
      -> [String]
      -> [String]
      -> [String]
      -> [String]
      -> PerCompilerFlavor [String]
      -> PerCompilerFlavor [String]
      -> PerCompilerFlavor [String]
      -> PerCompilerFlavor [String]
      -> [(String, String)]
      -> [Dependency]
      -> [Mixin]
      -> BuildInfo)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> ObjectCodec Bool Bool
forall output. HasCodec output => Text -> ObjectCodec output output
requiredField' Text
"buildable" ObjectCodec Bool Bool
-> (BuildInfo -> Bool) -> Codec Object BuildInfo Bool
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
.= BuildInfo -> Bool
buildable
        Codec
  Object
  BuildInfo
  ([LegacyExeDependency]
   -> [ExeDependency]
   -> [String]
   -> [String]
   -> [String]
   -> [String]
   -> [String]
   -> [String]
   -> [PkgconfigDependency]
   -> [String]
   -> [String]
   -> [String]
   -> [String]
   -> [String]
   -> [String]
   -> [String]
   -> [String]
   -> [ModuleName]
   -> [ModuleName]
   -> [ModuleName]
   -> Maybe Language
   -> [Language]
   -> [Extension]
   -> [Extension]
   -> [Extension]
   -> [String]
   -> [String]
   -> [String]
   -> [String]
   -> [String]
   -> [String]
   -> [String]
   -> [String]
   -> [String]
   -> [String]
   -> PerCompilerFlavor [String]
   -> PerCompilerFlavor [String]
   -> PerCompilerFlavor [String]
   -> PerCompilerFlavor [String]
   -> [(String, String)]
   -> [Dependency]
   -> [Mixin]
   -> BuildInfo)
-> Codec Object BuildInfo [LegacyExeDependency]
-> Codec
     Object
     BuildInfo
     ([ExeDependency]
      -> [String]
      -> [String]
      -> [String]
      -> [String]
      -> [String]
      -> [String]
      -> [PkgconfigDependency]
      -> [String]
      -> [String]
      -> [String]
      -> [String]
      -> [String]
      -> [String]
      -> [String]
      -> [String]
      -> [ModuleName]
      -> [ModuleName]
      -> [ModuleName]
      -> Maybe Language
      -> [Language]
      -> [Extension]
      -> [Extension]
      -> [Extension]
      -> [String]
      -> [String]
      -> [String]
      -> [String]
      -> [String]
      -> [String]
      -> [String]
      -> [String]
      -> [String]
      -> [String]
      -> PerCompilerFlavor [String]
      -> PerCompilerFlavor [String]
      -> PerCompilerFlavor [String]
      -> PerCompilerFlavor [String]
      -> [(String, String)]
      -> [Dependency]
      -> [Mixin]
      -> BuildInfo)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text -> ObjectCodec [LegacyExeDependency] [LegacyExeDependency]
forall output. HasCodec output => Text -> ObjectCodec output output
requiredField' Text
"buildTools" ObjectCodec [LegacyExeDependency] [LegacyExeDependency]
-> (BuildInfo -> [LegacyExeDependency])
-> Codec Object BuildInfo [LegacyExeDependency]
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
.= BuildInfo -> [LegacyExeDependency]
buildTools
        Codec
  Object
  BuildInfo
  ([ExeDependency]
   -> [String]
   -> [String]
   -> [String]
   -> [String]
   -> [String]
   -> [String]
   -> [PkgconfigDependency]
   -> [String]
   -> [String]
   -> [String]
   -> [String]
   -> [String]
   -> [String]
   -> [String]
   -> [String]
   -> [ModuleName]
   -> [ModuleName]
   -> [ModuleName]
   -> Maybe Language
   -> [Language]
   -> [Extension]
   -> [Extension]
   -> [Extension]
   -> [String]
   -> [String]
   -> [String]
   -> [String]
   -> [String]
   -> [String]
   -> [String]
   -> [String]
   -> [String]
   -> [String]
   -> PerCompilerFlavor [String]
   -> PerCompilerFlavor [String]
   -> PerCompilerFlavor [String]
   -> PerCompilerFlavor [String]
   -> [(String, String)]
   -> [Dependency]
   -> [Mixin]
   -> BuildInfo)
-> Codec Object BuildInfo [ExeDependency]
-> Codec
     Object
     BuildInfo
     ([String]
      -> [String]
      -> [String]
      -> [String]
      -> [String]
      -> [String]
      -> [PkgconfigDependency]
      -> [String]
      -> [String]
      -> [String]
      -> [String]
      -> [String]
      -> [String]
      -> [String]
      -> [String]
      -> [ModuleName]
      -> [ModuleName]
      -> [ModuleName]
      -> Maybe Language
      -> [Language]
      -> [Extension]
      -> [Extension]
      -> [Extension]
      -> [String]
      -> [String]
      -> [String]
      -> [String]
      -> [String]
      -> [String]
      -> [String]
      -> [String]
      -> [String]
      -> [String]
      -> PerCompilerFlavor [String]
      -> PerCompilerFlavor [String]
      -> PerCompilerFlavor [String]
      -> PerCompilerFlavor [String]
      -> [(String, String)]
      -> [Dependency]
      -> [Mixin]
      -> BuildInfo)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text -> ObjectCodec [ExeDependency] [ExeDependency]
forall output. HasCodec output => Text -> ObjectCodec output output
requiredField' Text
"buildToolDepends" ObjectCodec [ExeDependency] [ExeDependency]
-> (BuildInfo -> [ExeDependency])
-> Codec Object BuildInfo [ExeDependency]
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
.= BuildInfo -> [ExeDependency]
buildToolDepends
        Codec
  Object
  BuildInfo
  ([String]
   -> [String]
   -> [String]
   -> [String]
   -> [String]
   -> [String]
   -> [PkgconfigDependency]
   -> [String]
   -> [String]
   -> [String]
   -> [String]
   -> [String]
   -> [String]
   -> [String]
   -> [String]
   -> [ModuleName]
   -> [ModuleName]
   -> [ModuleName]
   -> Maybe Language
   -> [Language]
   -> [Extension]
   -> [Extension]
   -> [Extension]
   -> [String]
   -> [String]
   -> [String]
   -> [String]
   -> [String]
   -> [String]
   -> [String]
   -> [String]
   -> [String]
   -> [String]
   -> PerCompilerFlavor [String]
   -> PerCompilerFlavor [String]
   -> PerCompilerFlavor [String]
   -> PerCompilerFlavor [String]
   -> [(String, String)]
   -> [Dependency]
   -> [Mixin]
   -> BuildInfo)
-> Codec Object BuildInfo [String]
-> Codec
     Object
     BuildInfo
     ([String]
      -> [String]
      -> [String]
      -> [String]
      -> [String]
      -> [PkgconfigDependency]
      -> [String]
      -> [String]
      -> [String]
      -> [String]
      -> [String]
      -> [String]
      -> [String]
      -> [String]
      -> [ModuleName]
      -> [ModuleName]
      -> [ModuleName]
      -> Maybe Language
      -> [Language]
      -> [Extension]
      -> [Extension]
      -> [Extension]
      -> [String]
      -> [String]
      -> [String]
      -> [String]
      -> [String]
      -> [String]
      -> [String]
      -> [String]
      -> [String]
      -> [String]
      -> PerCompilerFlavor [String]
      -> PerCompilerFlavor [String]
      -> PerCompilerFlavor [String]
      -> PerCompilerFlavor [String]
      -> [(String, String)]
      -> [Dependency]
      -> [Mixin]
      -> BuildInfo)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text -> ObjectCodec [String] [String]
forall output. HasCodec output => Text -> ObjectCodec output output
requiredField' Text
"cppOptions" ObjectCodec [String] [String]
-> (BuildInfo -> [String]) -> Codec Object BuildInfo [String]
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
.= BuildInfo -> [String]
cppOptions
        Codec
  Object
  BuildInfo
  ([String]
   -> [String]
   -> [String]
   -> [String]
   -> [String]
   -> [PkgconfigDependency]
   -> [String]
   -> [String]
   -> [String]
   -> [String]
   -> [String]
   -> [String]
   -> [String]
   -> [String]
   -> [ModuleName]
   -> [ModuleName]
   -> [ModuleName]
   -> Maybe Language
   -> [Language]
   -> [Extension]
   -> [Extension]
   -> [Extension]
   -> [String]
   -> [String]
   -> [String]
   -> [String]
   -> [String]
   -> [String]
   -> [String]
   -> [String]
   -> [String]
   -> [String]
   -> PerCompilerFlavor [String]
   -> PerCompilerFlavor [String]
   -> PerCompilerFlavor [String]
   -> PerCompilerFlavor [String]
   -> [(String, String)]
   -> [Dependency]
   -> [Mixin]
   -> BuildInfo)
-> Codec Object BuildInfo [String]
-> Codec
     Object
     BuildInfo
     ([String]
      -> [String]
      -> [String]
      -> [String]
      -> [PkgconfigDependency]
      -> [String]
      -> [String]
      -> [String]
      -> [String]
      -> [String]
      -> [String]
      -> [String]
      -> [String]
      -> [ModuleName]
      -> [ModuleName]
      -> [ModuleName]
      -> Maybe Language
      -> [Language]
      -> [Extension]
      -> [Extension]
      -> [Extension]
      -> [String]
      -> [String]
      -> [String]
      -> [String]
      -> [String]
      -> [String]
      -> [String]
      -> [String]
      -> [String]
      -> [String]
      -> PerCompilerFlavor [String]
      -> PerCompilerFlavor [String]
      -> PerCompilerFlavor [String]
      -> PerCompilerFlavor [String]
      -> [(String, String)]
      -> [Dependency]
      -> [Mixin]
      -> BuildInfo)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text -> ObjectCodec [String] [String]
forall output. HasCodec output => Text -> ObjectCodec output output
requiredField' Text
"asmOptions" ObjectCodec [String] [String]
-> (BuildInfo -> [String]) -> Codec Object BuildInfo [String]
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
.= BuildInfo -> [String]
asmOptions
        Codec
  Object
  BuildInfo
  ([String]
   -> [String]
   -> [String]
   -> [String]
   -> [PkgconfigDependency]
   -> [String]
   -> [String]
   -> [String]
   -> [String]
   -> [String]
   -> [String]
   -> [String]
   -> [String]
   -> [ModuleName]
   -> [ModuleName]
   -> [ModuleName]
   -> Maybe Language
   -> [Language]
   -> [Extension]
   -> [Extension]
   -> [Extension]
   -> [String]
   -> [String]
   -> [String]
   -> [String]
   -> [String]
   -> [String]
   -> [String]
   -> [String]
   -> [String]
   -> [String]
   -> PerCompilerFlavor [String]
   -> PerCompilerFlavor [String]
   -> PerCompilerFlavor [String]
   -> PerCompilerFlavor [String]
   -> [(String, String)]
   -> [Dependency]
   -> [Mixin]
   -> BuildInfo)
-> Codec Object BuildInfo [String]
-> Codec
     Object
     BuildInfo
     ([String]
      -> [String]
      -> [String]
      -> [PkgconfigDependency]
      -> [String]
      -> [String]
      -> [String]
      -> [String]
      -> [String]
      -> [String]
      -> [String]
      -> [String]
      -> [ModuleName]
      -> [ModuleName]
      -> [ModuleName]
      -> Maybe Language
      -> [Language]
      -> [Extension]
      -> [Extension]
      -> [Extension]
      -> [String]
      -> [String]
      -> [String]
      -> [String]
      -> [String]
      -> [String]
      -> [String]
      -> [String]
      -> [String]
      -> [String]
      -> PerCompilerFlavor [String]
      -> PerCompilerFlavor [String]
      -> PerCompilerFlavor [String]
      -> PerCompilerFlavor [String]
      -> [(String, String)]
      -> [Dependency]
      -> [Mixin]
      -> BuildInfo)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text -> ObjectCodec [String] [String]
forall output. HasCodec output => Text -> ObjectCodec output output
requiredField' Text
"cmmOptions" ObjectCodec [String] [String]
-> (BuildInfo -> [String]) -> Codec Object BuildInfo [String]
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
.= BuildInfo -> [String]
cmmOptions
        Codec
  Object
  BuildInfo
  ([String]
   -> [String]
   -> [String]
   -> [PkgconfigDependency]
   -> [String]
   -> [String]
   -> [String]
   -> [String]
   -> [String]
   -> [String]
   -> [String]
   -> [String]
   -> [ModuleName]
   -> [ModuleName]
   -> [ModuleName]
   -> Maybe Language
   -> [Language]
   -> [Extension]
   -> [Extension]
   -> [Extension]
   -> [String]
   -> [String]
   -> [String]
   -> [String]
   -> [String]
   -> [String]
   -> [String]
   -> [String]
   -> [String]
   -> [String]
   -> PerCompilerFlavor [String]
   -> PerCompilerFlavor [String]
   -> PerCompilerFlavor [String]
   -> PerCompilerFlavor [String]
   -> [(String, String)]
   -> [Dependency]
   -> [Mixin]
   -> BuildInfo)
-> Codec Object BuildInfo [String]
-> Codec
     Object
     BuildInfo
     ([String]
      -> [String]
      -> [PkgconfigDependency]
      -> [String]
      -> [String]
      -> [String]
      -> [String]
      -> [String]
      -> [String]
      -> [String]
      -> [String]
      -> [ModuleName]
      -> [ModuleName]
      -> [ModuleName]
      -> Maybe Language
      -> [Language]
      -> [Extension]
      -> [Extension]
      -> [Extension]
      -> [String]
      -> [String]
      -> [String]
      -> [String]
      -> [String]
      -> [String]
      -> [String]
      -> [String]
      -> [String]
      -> [String]
      -> PerCompilerFlavor [String]
      -> PerCompilerFlavor [String]
      -> PerCompilerFlavor [String]
      -> PerCompilerFlavor [String]
      -> [(String, String)]
      -> [Dependency]
      -> [Mixin]
      -> BuildInfo)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text -> ObjectCodec [String] [String]
forall output. HasCodec output => Text -> ObjectCodec output output
requiredField' Text
"ccOptions" ObjectCodec [String] [String]
-> (BuildInfo -> [String]) -> Codec Object BuildInfo [String]
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
.= BuildInfo -> [String]
ccOptions
        Codec
  Object
  BuildInfo
  ([String]
   -> [String]
   -> [PkgconfigDependency]
   -> [String]
   -> [String]
   -> [String]
   -> [String]
   -> [String]
   -> [String]
   -> [String]
   -> [String]
   -> [ModuleName]
   -> [ModuleName]
   -> [ModuleName]
   -> Maybe Language
   -> [Language]
   -> [Extension]
   -> [Extension]
   -> [Extension]
   -> [String]
   -> [String]
   -> [String]
   -> [String]
   -> [String]
   -> [String]
   -> [String]
   -> [String]
   -> [String]
   -> [String]
   -> PerCompilerFlavor [String]
   -> PerCompilerFlavor [String]
   -> PerCompilerFlavor [String]
   -> PerCompilerFlavor [String]
   -> [(String, String)]
   -> [Dependency]
   -> [Mixin]
   -> BuildInfo)
-> Codec Object BuildInfo [String]
-> Codec
     Object
     BuildInfo
     ([String]
      -> [PkgconfigDependency]
      -> [String]
      -> [String]
      -> [String]
      -> [String]
      -> [String]
      -> [String]
      -> [String]
      -> [String]
      -> [ModuleName]
      -> [ModuleName]
      -> [ModuleName]
      -> Maybe Language
      -> [Language]
      -> [Extension]
      -> [Extension]
      -> [Extension]
      -> [String]
      -> [String]
      -> [String]
      -> [String]
      -> [String]
      -> [String]
      -> [String]
      -> [String]
      -> [String]
      -> [String]
      -> PerCompilerFlavor [String]
      -> PerCompilerFlavor [String]
      -> PerCompilerFlavor [String]
      -> PerCompilerFlavor [String]
      -> [(String, String)]
      -> [Dependency]
      -> [Mixin]
      -> BuildInfo)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text -> ObjectCodec [String] [String]
forall output. HasCodec output => Text -> ObjectCodec output output
requiredField' Text
"cxxOptions" ObjectCodec [String] [String]
-> (BuildInfo -> [String]) -> Codec Object BuildInfo [String]
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
.= BuildInfo -> [String]
cxxOptions
        Codec
  Object
  BuildInfo
  ([String]
   -> [PkgconfigDependency]
   -> [String]
   -> [String]
   -> [String]
   -> [String]
   -> [String]
   -> [String]
   -> [String]
   -> [String]
   -> [ModuleName]
   -> [ModuleName]
   -> [ModuleName]
   -> Maybe Language
   -> [Language]
   -> [Extension]
   -> [Extension]
   -> [Extension]
   -> [String]
   -> [String]
   -> [String]
   -> [String]
   -> [String]
   -> [String]
   -> [String]
   -> [String]
   -> [String]
   -> [String]
   -> PerCompilerFlavor [String]
   -> PerCompilerFlavor [String]
   -> PerCompilerFlavor [String]
   -> PerCompilerFlavor [String]
   -> [(String, String)]
   -> [Dependency]
   -> [Mixin]
   -> BuildInfo)
-> Codec Object BuildInfo [String]
-> Codec
     Object
     BuildInfo
     ([PkgconfigDependency]
      -> [String]
      -> [String]
      -> [String]
      -> [String]
      -> [String]
      -> [String]
      -> [String]
      -> [String]
      -> [ModuleName]
      -> [ModuleName]
      -> [ModuleName]
      -> Maybe Language
      -> [Language]
      -> [Extension]
      -> [Extension]
      -> [Extension]
      -> [String]
      -> [String]
      -> [String]
      -> [String]
      -> [String]
      -> [String]
      -> [String]
      -> [String]
      -> [String]
      -> [String]
      -> PerCompilerFlavor [String]
      -> PerCompilerFlavor [String]
      -> PerCompilerFlavor [String]
      -> PerCompilerFlavor [String]
      -> [(String, String)]
      -> [Dependency]
      -> [Mixin]
      -> BuildInfo)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text -> ObjectCodec [String] [String]
forall output. HasCodec output => Text -> ObjectCodec output output
requiredField' Text
"ldOptions" ObjectCodec [String] [String]
-> (BuildInfo -> [String]) -> Codec Object BuildInfo [String]
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
.= BuildInfo -> [String]
ldOptions
        Codec
  Object
  BuildInfo
  ([PkgconfigDependency]
   -> [String]
   -> [String]
   -> [String]
   -> [String]
   -> [String]
   -> [String]
   -> [String]
   -> [String]
   -> [ModuleName]
   -> [ModuleName]
   -> [ModuleName]
   -> Maybe Language
   -> [Language]
   -> [Extension]
   -> [Extension]
   -> [Extension]
   -> [String]
   -> [String]
   -> [String]
   -> [String]
   -> [String]
   -> [String]
   -> [String]
   -> [String]
   -> [String]
   -> [String]
   -> PerCompilerFlavor [String]
   -> PerCompilerFlavor [String]
   -> PerCompilerFlavor [String]
   -> PerCompilerFlavor [String]
   -> [(String, String)]
   -> [Dependency]
   -> [Mixin]
   -> BuildInfo)
-> Codec Object BuildInfo [PkgconfigDependency]
-> Codec
     Object
     BuildInfo
     ([String]
      -> [String]
      -> [String]
      -> [String]
      -> [String]
      -> [String]
      -> [String]
      -> [String]
      -> [ModuleName]
      -> [ModuleName]
      -> [ModuleName]
      -> Maybe Language
      -> [Language]
      -> [Extension]
      -> [Extension]
      -> [Extension]
      -> [String]
      -> [String]
      -> [String]
      -> [String]
      -> [String]
      -> [String]
      -> [String]
      -> [String]
      -> [String]
      -> [String]
      -> PerCompilerFlavor [String]
      -> PerCompilerFlavor [String]
      -> PerCompilerFlavor [String]
      -> PerCompilerFlavor [String]
      -> [(String, String)]
      -> [Dependency]
      -> [Mixin]
      -> BuildInfo)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text -> ObjectCodec [PkgconfigDependency] [PkgconfigDependency]
forall output. HasCodec output => Text -> ObjectCodec output output
requiredField' Text
"pkgconfigDepends" ObjectCodec [PkgconfigDependency] [PkgconfigDependency]
-> (BuildInfo -> [PkgconfigDependency])
-> Codec Object BuildInfo [PkgconfigDependency]
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
.= BuildInfo -> [PkgconfigDependency]
pkgconfigDepends
        Codec
  Object
  BuildInfo
  ([String]
   -> [String]
   -> [String]
   -> [String]
   -> [String]
   -> [String]
   -> [String]
   -> [String]
   -> [ModuleName]
   -> [ModuleName]
   -> [ModuleName]
   -> Maybe Language
   -> [Language]
   -> [Extension]
   -> [Extension]
   -> [Extension]
   -> [String]
   -> [String]
   -> [String]
   -> [String]
   -> [String]
   -> [String]
   -> [String]
   -> [String]
   -> [String]
   -> [String]
   -> PerCompilerFlavor [String]
   -> PerCompilerFlavor [String]
   -> PerCompilerFlavor [String]
   -> PerCompilerFlavor [String]
   -> [(String, String)]
   -> [Dependency]
   -> [Mixin]
   -> BuildInfo)
-> Codec Object BuildInfo [String]
-> Codec
     Object
     BuildInfo
     ([String]
      -> [String]
      -> [String]
      -> [String]
      -> [String]
      -> [String]
      -> [String]
      -> [ModuleName]
      -> [ModuleName]
      -> [ModuleName]
      -> Maybe Language
      -> [Language]
      -> [Extension]
      -> [Extension]
      -> [Extension]
      -> [String]
      -> [String]
      -> [String]
      -> [String]
      -> [String]
      -> [String]
      -> [String]
      -> [String]
      -> [String]
      -> [String]
      -> PerCompilerFlavor [String]
      -> PerCompilerFlavor [String]
      -> PerCompilerFlavor [String]
      -> PerCompilerFlavor [String]
      -> [(String, String)]
      -> [Dependency]
      -> [Mixin]
      -> BuildInfo)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text -> ObjectCodec [String] [String]
forall output. HasCodec output => Text -> ObjectCodec output output
requiredField' Text
"frameworks" ObjectCodec [String] [String]
-> (BuildInfo -> [String]) -> Codec Object BuildInfo [String]
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
.= BuildInfo -> [String]
frameworks
        Codec
  Object
  BuildInfo
  ([String]
   -> [String]
   -> [String]
   -> [String]
   -> [String]
   -> [String]
   -> [String]
   -> [ModuleName]
   -> [ModuleName]
   -> [ModuleName]
   -> Maybe Language
   -> [Language]
   -> [Extension]
   -> [Extension]
   -> [Extension]
   -> [String]
   -> [String]
   -> [String]
   -> [String]
   -> [String]
   -> [String]
   -> [String]
   -> [String]
   -> [String]
   -> [String]
   -> PerCompilerFlavor [String]
   -> PerCompilerFlavor [String]
   -> PerCompilerFlavor [String]
   -> PerCompilerFlavor [String]
   -> [(String, String)]
   -> [Dependency]
   -> [Mixin]
   -> BuildInfo)
-> Codec Object BuildInfo [String]
-> Codec
     Object
     BuildInfo
     ([String]
      -> [String]
      -> [String]
      -> [String]
      -> [String]
      -> [String]
      -> [ModuleName]
      -> [ModuleName]
      -> [ModuleName]
      -> Maybe Language
      -> [Language]
      -> [Extension]
      -> [Extension]
      -> [Extension]
      -> [String]
      -> [String]
      -> [String]
      -> [String]
      -> [String]
      -> [String]
      -> [String]
      -> [String]
      -> [String]
      -> [String]
      -> PerCompilerFlavor [String]
      -> PerCompilerFlavor [String]
      -> PerCompilerFlavor [String]
      -> PerCompilerFlavor [String]
      -> [(String, String)]
      -> [Dependency]
      -> [Mixin]
      -> BuildInfo)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text -> ObjectCodec [String] [String]
forall output. HasCodec output => Text -> ObjectCodec output output
requiredField' Text
"extraFrameworkDirs" ObjectCodec [String] [String]
-> (BuildInfo -> [String]) -> Codec Object BuildInfo [String]
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
.= BuildInfo -> [String]
extraFrameworkDirs
        Codec
  Object
  BuildInfo
  ([String]
   -> [String]
   -> [String]
   -> [String]
   -> [String]
   -> [String]
   -> [ModuleName]
   -> [ModuleName]
   -> [ModuleName]
   -> Maybe Language
   -> [Language]
   -> [Extension]
   -> [Extension]
   -> [Extension]
   -> [String]
   -> [String]
   -> [String]
   -> [String]
   -> [String]
   -> [String]
   -> [String]
   -> [String]
   -> [String]
   -> [String]
   -> PerCompilerFlavor [String]
   -> PerCompilerFlavor [String]
   -> PerCompilerFlavor [String]
   -> PerCompilerFlavor [String]
   -> [(String, String)]
   -> [Dependency]
   -> [Mixin]
   -> BuildInfo)
-> Codec Object BuildInfo [String]
-> Codec
     Object
     BuildInfo
     ([String]
      -> [String]
      -> [String]
      -> [String]
      -> [String]
      -> [ModuleName]
      -> [ModuleName]
      -> [ModuleName]
      -> Maybe Language
      -> [Language]
      -> [Extension]
      -> [Extension]
      -> [Extension]
      -> [String]
      -> [String]
      -> [String]
      -> [String]
      -> [String]
      -> [String]
      -> [String]
      -> [String]
      -> [String]
      -> [String]
      -> PerCompilerFlavor [String]
      -> PerCompilerFlavor [String]
      -> PerCompilerFlavor [String]
      -> PerCompilerFlavor [String]
      -> [(String, String)]
      -> [Dependency]
      -> [Mixin]
      -> BuildInfo)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text -> ObjectCodec [String] [String]
forall output. HasCodec output => Text -> ObjectCodec output output
requiredField' Text
"asmSources" ObjectCodec [String] [String]
-> (BuildInfo -> [String]) -> Codec Object BuildInfo [String]
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
.= BuildInfo -> [String]
asmSources
        Codec
  Object
  BuildInfo
  ([String]
   -> [String]
   -> [String]
   -> [String]
   -> [String]
   -> [ModuleName]
   -> [ModuleName]
   -> [ModuleName]
   -> Maybe Language
   -> [Language]
   -> [Extension]
   -> [Extension]
   -> [Extension]
   -> [String]
   -> [String]
   -> [String]
   -> [String]
   -> [String]
   -> [String]
   -> [String]
   -> [String]
   -> [String]
   -> [String]
   -> PerCompilerFlavor [String]
   -> PerCompilerFlavor [String]
   -> PerCompilerFlavor [String]
   -> PerCompilerFlavor [String]
   -> [(String, String)]
   -> [Dependency]
   -> [Mixin]
   -> BuildInfo)
-> Codec Object BuildInfo [String]
-> Codec
     Object
     BuildInfo
     ([String]
      -> [String]
      -> [String]
      -> [String]
      -> [ModuleName]
      -> [ModuleName]
      -> [ModuleName]
      -> Maybe Language
      -> [Language]
      -> [Extension]
      -> [Extension]
      -> [Extension]
      -> [String]
      -> [String]
      -> [String]
      -> [String]
      -> [String]
      -> [String]
      -> [String]
      -> [String]
      -> [String]
      -> [String]
      -> PerCompilerFlavor [String]
      -> PerCompilerFlavor [String]
      -> PerCompilerFlavor [String]
      -> PerCompilerFlavor [String]
      -> [(String, String)]
      -> [Dependency]
      -> [Mixin]
      -> BuildInfo)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text -> ObjectCodec [String] [String]
forall output. HasCodec output => Text -> ObjectCodec output output
requiredField' Text
"cmmSources" ObjectCodec [String] [String]
-> (BuildInfo -> [String]) -> Codec Object BuildInfo [String]
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
.= BuildInfo -> [String]
cmmSources
        Codec
  Object
  BuildInfo
  ([String]
   -> [String]
   -> [String]
   -> [String]
   -> [ModuleName]
   -> [ModuleName]
   -> [ModuleName]
   -> Maybe Language
   -> [Language]
   -> [Extension]
   -> [Extension]
   -> [Extension]
   -> [String]
   -> [String]
   -> [String]
   -> [String]
   -> [String]
   -> [String]
   -> [String]
   -> [String]
   -> [String]
   -> [String]
   -> PerCompilerFlavor [String]
   -> PerCompilerFlavor [String]
   -> PerCompilerFlavor [String]
   -> PerCompilerFlavor [String]
   -> [(String, String)]
   -> [Dependency]
   -> [Mixin]
   -> BuildInfo)
-> Codec Object BuildInfo [String]
-> Codec
     Object
     BuildInfo
     ([String]
      -> [String]
      -> [String]
      -> [ModuleName]
      -> [ModuleName]
      -> [ModuleName]
      -> Maybe Language
      -> [Language]
      -> [Extension]
      -> [Extension]
      -> [Extension]
      -> [String]
      -> [String]
      -> [String]
      -> [String]
      -> [String]
      -> [String]
      -> [String]
      -> [String]
      -> [String]
      -> [String]
      -> PerCompilerFlavor [String]
      -> PerCompilerFlavor [String]
      -> PerCompilerFlavor [String]
      -> PerCompilerFlavor [String]
      -> [(String, String)]
      -> [Dependency]
      -> [Mixin]
      -> BuildInfo)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text -> ObjectCodec [String] [String]
forall output. HasCodec output => Text -> ObjectCodec output output
requiredField' Text
"cSources" ObjectCodec [String] [String]
-> (BuildInfo -> [String]) -> Codec Object BuildInfo [String]
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
.= BuildInfo -> [String]
cSources
        Codec
  Object
  BuildInfo
  ([String]
   -> [String]
   -> [String]
   -> [ModuleName]
   -> [ModuleName]
   -> [ModuleName]
   -> Maybe Language
   -> [Language]
   -> [Extension]
   -> [Extension]
   -> [Extension]
   -> [String]
   -> [String]
   -> [String]
   -> [String]
   -> [String]
   -> [String]
   -> [String]
   -> [String]
   -> [String]
   -> [String]
   -> PerCompilerFlavor [String]
   -> PerCompilerFlavor [String]
   -> PerCompilerFlavor [String]
   -> PerCompilerFlavor [String]
   -> [(String, String)]
   -> [Dependency]
   -> [Mixin]
   -> BuildInfo)
-> Codec Object BuildInfo [String]
-> Codec
     Object
     BuildInfo
     ([String]
      -> [String]
      -> [ModuleName]
      -> [ModuleName]
      -> [ModuleName]
      -> Maybe Language
      -> [Language]
      -> [Extension]
      -> [Extension]
      -> [Extension]
      -> [String]
      -> [String]
      -> [String]
      -> [String]
      -> [String]
      -> [String]
      -> [String]
      -> [String]
      -> [String]
      -> [String]
      -> PerCompilerFlavor [String]
      -> PerCompilerFlavor [String]
      -> PerCompilerFlavor [String]
      -> PerCompilerFlavor [String]
      -> [(String, String)]
      -> [Dependency]
      -> [Mixin]
      -> BuildInfo)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text -> ObjectCodec [String] [String]
forall output. HasCodec output => Text -> ObjectCodec output output
requiredField' Text
"cxxSources" ObjectCodec [String] [String]
-> (BuildInfo -> [String]) -> Codec Object BuildInfo [String]
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
.= BuildInfo -> [String]
cxxSources
        Codec
  Object
  BuildInfo
  ([String]
   -> [String]
   -> [ModuleName]
   -> [ModuleName]
   -> [ModuleName]
   -> Maybe Language
   -> [Language]
   -> [Extension]
   -> [Extension]
   -> [Extension]
   -> [String]
   -> [String]
   -> [String]
   -> [String]
   -> [String]
   -> [String]
   -> [String]
   -> [String]
   -> [String]
   -> [String]
   -> PerCompilerFlavor [String]
   -> PerCompilerFlavor [String]
   -> PerCompilerFlavor [String]
   -> PerCompilerFlavor [String]
   -> [(String, String)]
   -> [Dependency]
   -> [Mixin]
   -> BuildInfo)
-> Codec Object BuildInfo [String]
-> Codec
     Object
     BuildInfo
     ([String]
      -> [ModuleName]
      -> [ModuleName]
      -> [ModuleName]
      -> Maybe Language
      -> [Language]
      -> [Extension]
      -> [Extension]
      -> [Extension]
      -> [String]
      -> [String]
      -> [String]
      -> [String]
      -> [String]
      -> [String]
      -> [String]
      -> [String]
      -> [String]
      -> [String]
      -> PerCompilerFlavor [String]
      -> PerCompilerFlavor [String]
      -> PerCompilerFlavor [String]
      -> PerCompilerFlavor [String]
      -> [(String, String)]
      -> [Dependency]
      -> [Mixin]
      -> BuildInfo)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text -> ObjectCodec [String] [String]
forall output. HasCodec output => Text -> ObjectCodec output output
requiredField' Text
"jsSources" ObjectCodec [String] [String]
-> (BuildInfo -> [String]) -> Codec Object BuildInfo [String]
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
.= BuildInfo -> [String]
jsSources
        Codec
  Object
  BuildInfo
  ([String]
   -> [ModuleName]
   -> [ModuleName]
   -> [ModuleName]
   -> Maybe Language
   -> [Language]
   -> [Extension]
   -> [Extension]
   -> [Extension]
   -> [String]
   -> [String]
   -> [String]
   -> [String]
   -> [String]
   -> [String]
   -> [String]
   -> [String]
   -> [String]
   -> [String]
   -> PerCompilerFlavor [String]
   -> PerCompilerFlavor [String]
   -> PerCompilerFlavor [String]
   -> PerCompilerFlavor [String]
   -> [(String, String)]
   -> [Dependency]
   -> [Mixin]
   -> BuildInfo)
-> Codec Object BuildInfo [String]
-> Codec
     Object
     BuildInfo
     ([ModuleName]
      -> [ModuleName]
      -> [ModuleName]
      -> Maybe Language
      -> [Language]
      -> [Extension]
      -> [Extension]
      -> [Extension]
      -> [String]
      -> [String]
      -> [String]
      -> [String]
      -> [String]
      -> [String]
      -> [String]
      -> [String]
      -> [String]
      -> [String]
      -> PerCompilerFlavor [String]
      -> PerCompilerFlavor [String]
      -> PerCompilerFlavor [String]
      -> PerCompilerFlavor [String]
      -> [(String, String)]
      -> [Dependency]
      -> [Mixin]
      -> BuildInfo)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text -> ObjectCodec [String] [String]
forall output. HasCodec output => Text -> ObjectCodec output output
requiredField' Text
"hsSourceDirs" ObjectCodec [String] [String]
-> (BuildInfo -> [String]) -> Codec Object BuildInfo [String]
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
.= BuildInfo -> [String]
hsSourceDirs
        Codec
  Object
  BuildInfo
  ([ModuleName]
   -> [ModuleName]
   -> [ModuleName]
   -> Maybe Language
   -> [Language]
   -> [Extension]
   -> [Extension]
   -> [Extension]
   -> [String]
   -> [String]
   -> [String]
   -> [String]
   -> [String]
   -> [String]
   -> [String]
   -> [String]
   -> [String]
   -> [String]
   -> PerCompilerFlavor [String]
   -> PerCompilerFlavor [String]
   -> PerCompilerFlavor [String]
   -> PerCompilerFlavor [String]
   -> [(String, String)]
   -> [Dependency]
   -> [Mixin]
   -> BuildInfo)
-> Codec Object BuildInfo [ModuleName]
-> Codec
     Object
     BuildInfo
     ([ModuleName]
      -> [ModuleName]
      -> Maybe Language
      -> [Language]
      -> [Extension]
      -> [Extension]
      -> [Extension]
      -> [String]
      -> [String]
      -> [String]
      -> [String]
      -> [String]
      -> [String]
      -> [String]
      -> [String]
      -> [String]
      -> [String]
      -> PerCompilerFlavor [String]
      -> PerCompilerFlavor [String]
      -> PerCompilerFlavor [String]
      -> PerCompilerFlavor [String]
      -> [(String, String)]
      -> [Dependency]
      -> [Mixin]
      -> BuildInfo)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text -> ObjectCodec [ModuleName] [ModuleName]
forall output. HasCodec output => Text -> ObjectCodec output output
requiredField' Text
"otherModules" ObjectCodec [ModuleName] [ModuleName]
-> (BuildInfo -> [ModuleName])
-> Codec Object BuildInfo [ModuleName]
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
.= BuildInfo -> [ModuleName]
otherModules
        Codec
  Object
  BuildInfo
  ([ModuleName]
   -> [ModuleName]
   -> Maybe Language
   -> [Language]
   -> [Extension]
   -> [Extension]
   -> [Extension]
   -> [String]
   -> [String]
   -> [String]
   -> [String]
   -> [String]
   -> [String]
   -> [String]
   -> [String]
   -> [String]
   -> [String]
   -> PerCompilerFlavor [String]
   -> PerCompilerFlavor [String]
   -> PerCompilerFlavor [String]
   -> PerCompilerFlavor [String]
   -> [(String, String)]
   -> [Dependency]
   -> [Mixin]
   -> BuildInfo)
-> Codec Object BuildInfo [ModuleName]
-> Codec
     Object
     BuildInfo
     ([ModuleName]
      -> Maybe Language
      -> [Language]
      -> [Extension]
      -> [Extension]
      -> [Extension]
      -> [String]
      -> [String]
      -> [String]
      -> [String]
      -> [String]
      -> [String]
      -> [String]
      -> [String]
      -> [String]
      -> [String]
      -> PerCompilerFlavor [String]
      -> PerCompilerFlavor [String]
      -> PerCompilerFlavor [String]
      -> PerCompilerFlavor [String]
      -> [(String, String)]
      -> [Dependency]
      -> [Mixin]
      -> BuildInfo)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text -> ObjectCodec [ModuleName] [ModuleName]
forall output. HasCodec output => Text -> ObjectCodec output output
requiredField' Text
"virtualModules" ObjectCodec [ModuleName] [ModuleName]
-> (BuildInfo -> [ModuleName])
-> Codec Object BuildInfo [ModuleName]
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
.= BuildInfo -> [ModuleName]
virtualModules
        Codec
  Object
  BuildInfo
  ([ModuleName]
   -> Maybe Language
   -> [Language]
   -> [Extension]
   -> [Extension]
   -> [Extension]
   -> [String]
   -> [String]
   -> [String]
   -> [String]
   -> [String]
   -> [String]
   -> [String]
   -> [String]
   -> [String]
   -> [String]
   -> PerCompilerFlavor [String]
   -> PerCompilerFlavor [String]
   -> PerCompilerFlavor [String]
   -> PerCompilerFlavor [String]
   -> [(String, String)]
   -> [Dependency]
   -> [Mixin]
   -> BuildInfo)
-> Codec Object BuildInfo [ModuleName]
-> Codec
     Object
     BuildInfo
     (Maybe Language
      -> [Language]
      -> [Extension]
      -> [Extension]
      -> [Extension]
      -> [String]
      -> [String]
      -> [String]
      -> [String]
      -> [String]
      -> [String]
      -> [String]
      -> [String]
      -> [String]
      -> [String]
      -> PerCompilerFlavor [String]
      -> PerCompilerFlavor [String]
      -> PerCompilerFlavor [String]
      -> PerCompilerFlavor [String]
      -> [(String, String)]
      -> [Dependency]
      -> [Mixin]
      -> BuildInfo)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text -> ObjectCodec [ModuleName] [ModuleName]
forall output. HasCodec output => Text -> ObjectCodec output output
requiredField' Text
"autogenModules" ObjectCodec [ModuleName] [ModuleName]
-> (BuildInfo -> [ModuleName])
-> Codec Object BuildInfo [ModuleName]
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
.= BuildInfo -> [ModuleName]
autogenModules
        Codec
  Object
  BuildInfo
  (Maybe Language
   -> [Language]
   -> [Extension]
   -> [Extension]
   -> [Extension]
   -> [String]
   -> [String]
   -> [String]
   -> [String]
   -> [String]
   -> [String]
   -> [String]
   -> [String]
   -> [String]
   -> [String]
   -> PerCompilerFlavor [String]
   -> PerCompilerFlavor [String]
   -> PerCompilerFlavor [String]
   -> PerCompilerFlavor [String]
   -> [(String, String)]
   -> [Dependency]
   -> [Mixin]
   -> BuildInfo)
-> Codec Object BuildInfo (Maybe Language)
-> Codec
     Object
     BuildInfo
     ([Language]
      -> [Extension]
      -> [Extension]
      -> [Extension]
      -> [String]
      -> [String]
      -> [String]
      -> [String]
      -> [String]
      -> [String]
      -> [String]
      -> [String]
      -> [String]
      -> [String]
      -> PerCompilerFlavor [String]
      -> PerCompilerFlavor [String]
      -> PerCompilerFlavor [String]
      -> PerCompilerFlavor [String]
      -> [(String, String)]
      -> [Dependency]
      -> [Mixin]
      -> BuildInfo)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text -> ObjectCodec (Maybe Language) (Maybe Language)
forall output. HasCodec output => Text -> ObjectCodec output output
requiredField' Text
"defaultLanguage" ObjectCodec (Maybe Language) (Maybe Language)
-> (BuildInfo -> Maybe Language)
-> Codec Object BuildInfo (Maybe Language)
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
.= BuildInfo -> Maybe Language
defaultLanguage
        Codec
  Object
  BuildInfo
  ([Language]
   -> [Extension]
   -> [Extension]
   -> [Extension]
   -> [String]
   -> [String]
   -> [String]
   -> [String]
   -> [String]
   -> [String]
   -> [String]
   -> [String]
   -> [String]
   -> [String]
   -> PerCompilerFlavor [String]
   -> PerCompilerFlavor [String]
   -> PerCompilerFlavor [String]
   -> PerCompilerFlavor [String]
   -> [(String, String)]
   -> [Dependency]
   -> [Mixin]
   -> BuildInfo)
-> Codec Object BuildInfo [Language]
-> Codec
     Object
     BuildInfo
     ([Extension]
      -> [Extension]
      -> [Extension]
      -> [String]
      -> [String]
      -> [String]
      -> [String]
      -> [String]
      -> [String]
      -> [String]
      -> [String]
      -> [String]
      -> [String]
      -> PerCompilerFlavor [String]
      -> PerCompilerFlavor [String]
      -> PerCompilerFlavor [String]
      -> PerCompilerFlavor [String]
      -> [(String, String)]
      -> [Dependency]
      -> [Mixin]
      -> BuildInfo)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text -> ObjectCodec [Language] [Language]
forall output. HasCodec output => Text -> ObjectCodec output output
requiredField' Text
"otherLanguages" ObjectCodec [Language] [Language]
-> (BuildInfo -> [Language]) -> Codec Object BuildInfo [Language]
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
.= BuildInfo -> [Language]
otherLanguages
        Codec
  Object
  BuildInfo
  ([Extension]
   -> [Extension]
   -> [Extension]
   -> [String]
   -> [String]
   -> [String]
   -> [String]
   -> [String]
   -> [String]
   -> [String]
   -> [String]
   -> [String]
   -> [String]
   -> PerCompilerFlavor [String]
   -> PerCompilerFlavor [String]
   -> PerCompilerFlavor [String]
   -> PerCompilerFlavor [String]
   -> [(String, String)]
   -> [Dependency]
   -> [Mixin]
   -> BuildInfo)
-> Codec Object BuildInfo [Extension]
-> Codec
     Object
     BuildInfo
     ([Extension]
      -> [Extension]
      -> [String]
      -> [String]
      -> [String]
      -> [String]
      -> [String]
      -> [String]
      -> [String]
      -> [String]
      -> [String]
      -> [String]
      -> PerCompilerFlavor [String]
      -> PerCompilerFlavor [String]
      -> PerCompilerFlavor [String]
      -> PerCompilerFlavor [String]
      -> [(String, String)]
      -> [Dependency]
      -> [Mixin]
      -> BuildInfo)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text -> ObjectCodec [Extension] [Extension]
forall output. HasCodec output => Text -> ObjectCodec output output
requiredField' Text
"defaultExtensions" ObjectCodec [Extension] [Extension]
-> (BuildInfo -> [Extension]) -> Codec Object BuildInfo [Extension]
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
.= BuildInfo -> [Extension]
defaultExtensions
        Codec
  Object
  BuildInfo
  ([Extension]
   -> [Extension]
   -> [String]
   -> [String]
   -> [String]
   -> [String]
   -> [String]
   -> [String]
   -> [String]
   -> [String]
   -> [String]
   -> [String]
   -> PerCompilerFlavor [String]
   -> PerCompilerFlavor [String]
   -> PerCompilerFlavor [String]
   -> PerCompilerFlavor [String]
   -> [(String, String)]
   -> [Dependency]
   -> [Mixin]
   -> BuildInfo)
-> Codec Object BuildInfo [Extension]
-> Codec
     Object
     BuildInfo
     ([Extension]
      -> [String]
      -> [String]
      -> [String]
      -> [String]
      -> [String]
      -> [String]
      -> [String]
      -> [String]
      -> [String]
      -> [String]
      -> PerCompilerFlavor [String]
      -> PerCompilerFlavor [String]
      -> PerCompilerFlavor [String]
      -> PerCompilerFlavor [String]
      -> [(String, String)]
      -> [Dependency]
      -> [Mixin]
      -> BuildInfo)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text -> ObjectCodec [Extension] [Extension]
forall output. HasCodec output => Text -> ObjectCodec output output
requiredField' Text
"otherExtensions" ObjectCodec [Extension] [Extension]
-> (BuildInfo -> [Extension]) -> Codec Object BuildInfo [Extension]
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
.= BuildInfo -> [Extension]
otherExtensions
        Codec
  Object
  BuildInfo
  ([Extension]
   -> [String]
   -> [String]
   -> [String]
   -> [String]
   -> [String]
   -> [String]
   -> [String]
   -> [String]
   -> [String]
   -> [String]
   -> PerCompilerFlavor [String]
   -> PerCompilerFlavor [String]
   -> PerCompilerFlavor [String]
   -> PerCompilerFlavor [String]
   -> [(String, String)]
   -> [Dependency]
   -> [Mixin]
   -> BuildInfo)
-> Codec Object BuildInfo [Extension]
-> Codec
     Object
     BuildInfo
     ([String]
      -> [String]
      -> [String]
      -> [String]
      -> [String]
      -> [String]
      -> [String]
      -> [String]
      -> [String]
      -> [String]
      -> PerCompilerFlavor [String]
      -> PerCompilerFlavor [String]
      -> PerCompilerFlavor [String]
      -> PerCompilerFlavor [String]
      -> [(String, String)]
      -> [Dependency]
      -> [Mixin]
      -> BuildInfo)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text -> ObjectCodec [Extension] [Extension]
forall output. HasCodec output => Text -> ObjectCodec output output
requiredField' Text
"oldExtensions" ObjectCodec [Extension] [Extension]
-> (BuildInfo -> [Extension]) -> Codec Object BuildInfo [Extension]
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
.= BuildInfo -> [Extension]
oldExtensions
        Codec
  Object
  BuildInfo
  ([String]
   -> [String]
   -> [String]
   -> [String]
   -> [String]
   -> [String]
   -> [String]
   -> [String]
   -> [String]
   -> [String]
   -> PerCompilerFlavor [String]
   -> PerCompilerFlavor [String]
   -> PerCompilerFlavor [String]
   -> PerCompilerFlavor [String]
   -> [(String, String)]
   -> [Dependency]
   -> [Mixin]
   -> BuildInfo)
-> Codec Object BuildInfo [String]
-> Codec
     Object
     BuildInfo
     ([String]
      -> [String]
      -> [String]
      -> [String]
      -> [String]
      -> [String]
      -> [String]
      -> [String]
      -> [String]
      -> PerCompilerFlavor [String]
      -> PerCompilerFlavor [String]
      -> PerCompilerFlavor [String]
      -> PerCompilerFlavor [String]
      -> [(String, String)]
      -> [Dependency]
      -> [Mixin]
      -> BuildInfo)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text -> ObjectCodec [String] [String]
forall output. HasCodec output => Text -> ObjectCodec output output
requiredField' Text
"extraLibs" ObjectCodec [String] [String]
-> (BuildInfo -> [String]) -> Codec Object BuildInfo [String]
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
.= BuildInfo -> [String]
extraLibs
        Codec
  Object
  BuildInfo
  ([String]
   -> [String]
   -> [String]
   -> [String]
   -> [String]
   -> [String]
   -> [String]
   -> [String]
   -> [String]
   -> PerCompilerFlavor [String]
   -> PerCompilerFlavor [String]
   -> PerCompilerFlavor [String]
   -> PerCompilerFlavor [String]
   -> [(String, String)]
   -> [Dependency]
   -> [Mixin]
   -> BuildInfo)
-> Codec Object BuildInfo [String]
-> Codec
     Object
     BuildInfo
     ([String]
      -> [String]
      -> [String]
      -> [String]
      -> [String]
      -> [String]
      -> [String]
      -> [String]
      -> PerCompilerFlavor [String]
      -> PerCompilerFlavor [String]
      -> PerCompilerFlavor [String]
      -> PerCompilerFlavor [String]
      -> [(String, String)]
      -> [Dependency]
      -> [Mixin]
      -> BuildInfo)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text -> ObjectCodec [String] [String]
forall output. HasCodec output => Text -> ObjectCodec output output
requiredField' Text
"extraGHCiLibs" ObjectCodec [String] [String]
-> (BuildInfo -> [String]) -> Codec Object BuildInfo [String]
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
.= BuildInfo -> [String]
extraGHCiLibs
        Codec
  Object
  BuildInfo
  ([String]
   -> [String]
   -> [String]
   -> [String]
   -> [String]
   -> [String]
   -> [String]
   -> [String]
   -> PerCompilerFlavor [String]
   -> PerCompilerFlavor [String]
   -> PerCompilerFlavor [String]
   -> PerCompilerFlavor [String]
   -> [(String, String)]
   -> [Dependency]
   -> [Mixin]
   -> BuildInfo)
-> Codec Object BuildInfo [String]
-> Codec
     Object
     BuildInfo
     ([String]
      -> [String]
      -> [String]
      -> [String]
      -> [String]
      -> [String]
      -> [String]
      -> PerCompilerFlavor [String]
      -> PerCompilerFlavor [String]
      -> PerCompilerFlavor [String]
      -> PerCompilerFlavor [String]
      -> [(String, String)]
      -> [Dependency]
      -> [Mixin]
      -> BuildInfo)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text -> ObjectCodec [String] [String]
forall output. HasCodec output => Text -> ObjectCodec output output
requiredField' Text
"extraBundledLibs" ObjectCodec [String] [String]
-> (BuildInfo -> [String]) -> Codec Object BuildInfo [String]
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
.= BuildInfo -> [String]
extraBundledLibs
        Codec
  Object
  BuildInfo
  ([String]
   -> [String]
   -> [String]
   -> [String]
   -> [String]
   -> [String]
   -> [String]
   -> PerCompilerFlavor [String]
   -> PerCompilerFlavor [String]
   -> PerCompilerFlavor [String]
   -> PerCompilerFlavor [String]
   -> [(String, String)]
   -> [Dependency]
   -> [Mixin]
   -> BuildInfo)
-> Codec Object BuildInfo [String]
-> Codec
     Object
     BuildInfo
     ([String]
      -> [String]
      -> [String]
      -> [String]
      -> [String]
      -> [String]
      -> PerCompilerFlavor [String]
      -> PerCompilerFlavor [String]
      -> PerCompilerFlavor [String]
      -> PerCompilerFlavor [String]
      -> [(String, String)]
      -> [Dependency]
      -> [Mixin]
      -> BuildInfo)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text -> ObjectCodec [String] [String]
forall output. HasCodec output => Text -> ObjectCodec output output
requiredField' Text
"extraLibFlavours" ObjectCodec [String] [String]
-> (BuildInfo -> [String]) -> Codec Object BuildInfo [String]
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
.= BuildInfo -> [String]
extraLibFlavours
        Codec
  Object
  BuildInfo
  ([String]
   -> [String]
   -> [String]
   -> [String]
   -> [String]
   -> [String]
   -> PerCompilerFlavor [String]
   -> PerCompilerFlavor [String]
   -> PerCompilerFlavor [String]
   -> PerCompilerFlavor [String]
   -> [(String, String)]
   -> [Dependency]
   -> [Mixin]
   -> BuildInfo)
-> Codec Object BuildInfo [String]
-> Codec
     Object
     BuildInfo
     ([String]
      -> [String]
      -> [String]
      -> [String]
      -> [String]
      -> PerCompilerFlavor [String]
      -> PerCompilerFlavor [String]
      -> PerCompilerFlavor [String]
      -> PerCompilerFlavor [String]
      -> [(String, String)]
      -> [Dependency]
      -> [Mixin]
      -> BuildInfo)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text -> ObjectCodec [String] [String]
forall output. HasCodec output => Text -> ObjectCodec output output
requiredField' Text
"extraDynLibFlavours" ObjectCodec [String] [String]
-> (BuildInfo -> [String]) -> Codec Object BuildInfo [String]
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
.= BuildInfo -> [String]
extraDynLibFlavours
        Codec
  Object
  BuildInfo
  ([String]
   -> [String]
   -> [String]
   -> [String]
   -> [String]
   -> PerCompilerFlavor [String]
   -> PerCompilerFlavor [String]
   -> PerCompilerFlavor [String]
   -> PerCompilerFlavor [String]
   -> [(String, String)]
   -> [Dependency]
   -> [Mixin]
   -> BuildInfo)
-> Codec Object BuildInfo [String]
-> Codec
     Object
     BuildInfo
     ([String]
      -> [String]
      -> [String]
      -> [String]
      -> PerCompilerFlavor [String]
      -> PerCompilerFlavor [String]
      -> PerCompilerFlavor [String]
      -> PerCompilerFlavor [String]
      -> [(String, String)]
      -> [Dependency]
      -> [Mixin]
      -> BuildInfo)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text -> ObjectCodec [String] [String]
forall output. HasCodec output => Text -> ObjectCodec output output
requiredField' Text
"extraLibDirs" ObjectCodec [String] [String]
-> (BuildInfo -> [String]) -> Codec Object BuildInfo [String]
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
.= BuildInfo -> [String]
extraLibDirs
        Codec
  Object
  BuildInfo
  ([String]
   -> [String]
   -> [String]
   -> [String]
   -> PerCompilerFlavor [String]
   -> PerCompilerFlavor [String]
   -> PerCompilerFlavor [String]
   -> PerCompilerFlavor [String]
   -> [(String, String)]
   -> [Dependency]
   -> [Mixin]
   -> BuildInfo)
-> Codec Object BuildInfo [String]
-> Codec
     Object
     BuildInfo
     ([String]
      -> [String]
      -> [String]
      -> PerCompilerFlavor [String]
      -> PerCompilerFlavor [String]
      -> PerCompilerFlavor [String]
      -> PerCompilerFlavor [String]
      -> [(String, String)]
      -> [Dependency]
      -> [Mixin]
      -> BuildInfo)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text -> ObjectCodec [String] [String]
forall output. HasCodec output => Text -> ObjectCodec output output
requiredField' Text
"includeDirs" ObjectCodec [String] [String]
-> (BuildInfo -> [String]) -> Codec Object BuildInfo [String]
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
.= BuildInfo -> [String]
includeDirs
        Codec
  Object
  BuildInfo
  ([String]
   -> [String]
   -> [String]
   -> PerCompilerFlavor [String]
   -> PerCompilerFlavor [String]
   -> PerCompilerFlavor [String]
   -> PerCompilerFlavor [String]
   -> [(String, String)]
   -> [Dependency]
   -> [Mixin]
   -> BuildInfo)
-> Codec Object BuildInfo [String]
-> Codec
     Object
     BuildInfo
     ([String]
      -> [String]
      -> PerCompilerFlavor [String]
      -> PerCompilerFlavor [String]
      -> PerCompilerFlavor [String]
      -> PerCompilerFlavor [String]
      -> [(String, String)]
      -> [Dependency]
      -> [Mixin]
      -> BuildInfo)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text -> ObjectCodec [String] [String]
forall output. HasCodec output => Text -> ObjectCodec output output
requiredField' Text
"includes" ObjectCodec [String] [String]
-> (BuildInfo -> [String]) -> Codec Object BuildInfo [String]
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
.= BuildInfo -> [String]
includes
        Codec
  Object
  BuildInfo
  ([String]
   -> [String]
   -> PerCompilerFlavor [String]
   -> PerCompilerFlavor [String]
   -> PerCompilerFlavor [String]
   -> PerCompilerFlavor [String]
   -> [(String, String)]
   -> [Dependency]
   -> [Mixin]
   -> BuildInfo)
-> Codec Object BuildInfo [String]
-> Codec
     Object
     BuildInfo
     ([String]
      -> PerCompilerFlavor [String]
      -> PerCompilerFlavor [String]
      -> PerCompilerFlavor [String]
      -> PerCompilerFlavor [String]
      -> [(String, String)]
      -> [Dependency]
      -> [Mixin]
      -> BuildInfo)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text -> ObjectCodec [String] [String]
forall output. HasCodec output => Text -> ObjectCodec output output
requiredField' Text
"autogenIncludes" ObjectCodec [String] [String]
-> (BuildInfo -> [String]) -> Codec Object BuildInfo [String]
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
.= BuildInfo -> [String]
autogenIncludes
        Codec
  Object
  BuildInfo
  ([String]
   -> PerCompilerFlavor [String]
   -> PerCompilerFlavor [String]
   -> PerCompilerFlavor [String]
   -> PerCompilerFlavor [String]
   -> [(String, String)]
   -> [Dependency]
   -> [Mixin]
   -> BuildInfo)
-> Codec Object BuildInfo [String]
-> Codec
     Object
     BuildInfo
     (PerCompilerFlavor [String]
      -> PerCompilerFlavor [String]
      -> PerCompilerFlavor [String]
      -> PerCompilerFlavor [String]
      -> [(String, String)]
      -> [Dependency]
      -> [Mixin]
      -> BuildInfo)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text -> ObjectCodec [String] [String]
forall output. HasCodec output => Text -> ObjectCodec output output
requiredField' Text
"installIncludes" ObjectCodec [String] [String]
-> (BuildInfo -> [String]) -> Codec Object BuildInfo [String]
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
.= BuildInfo -> [String]
installIncludes
        Codec
  Object
  BuildInfo
  (PerCompilerFlavor [String]
   -> PerCompilerFlavor [String]
   -> PerCompilerFlavor [String]
   -> PerCompilerFlavor [String]
   -> [(String, String)]
   -> [Dependency]
   -> [Mixin]
   -> BuildInfo)
-> Codec Object BuildInfo (PerCompilerFlavor [String])
-> Codec
     Object
     BuildInfo
     (PerCompilerFlavor [String]
      -> PerCompilerFlavor [String]
      -> PerCompilerFlavor [String]
      -> [(String, String)]
      -> [Dependency]
      -> [Mixin]
      -> BuildInfo)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text
-> ObjectCodec
     (PerCompilerFlavor [String]) (PerCompilerFlavor [String])
forall output. HasCodec output => Text -> ObjectCodec output output
requiredField' Text
"options" ObjectCodec
  (PerCompilerFlavor [String]) (PerCompilerFlavor [String])
-> (BuildInfo -> PerCompilerFlavor [String])
-> Codec Object BuildInfo (PerCompilerFlavor [String])
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
.= BuildInfo -> PerCompilerFlavor [String]
options
        Codec
  Object
  BuildInfo
  (PerCompilerFlavor [String]
   -> PerCompilerFlavor [String]
   -> PerCompilerFlavor [String]
   -> [(String, String)]
   -> [Dependency]
   -> [Mixin]
   -> BuildInfo)
-> Codec Object BuildInfo (PerCompilerFlavor [String])
-> Codec
     Object
     BuildInfo
     (PerCompilerFlavor [String]
      -> PerCompilerFlavor [String]
      -> [(String, String)]
      -> [Dependency]
      -> [Mixin]
      -> BuildInfo)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text
-> ObjectCodec
     (PerCompilerFlavor [String]) (PerCompilerFlavor [String])
forall output. HasCodec output => Text -> ObjectCodec output output
requiredField' Text
"profOptions" ObjectCodec
  (PerCompilerFlavor [String]) (PerCompilerFlavor [String])
-> (BuildInfo -> PerCompilerFlavor [String])
-> Codec Object BuildInfo (PerCompilerFlavor [String])
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
.= BuildInfo -> PerCompilerFlavor [String]
profOptions
        Codec
  Object
  BuildInfo
  (PerCompilerFlavor [String]
   -> PerCompilerFlavor [String]
   -> [(String, String)]
   -> [Dependency]
   -> [Mixin]
   -> BuildInfo)
-> Codec Object BuildInfo (PerCompilerFlavor [String])
-> Codec
     Object
     BuildInfo
     (PerCompilerFlavor [String]
      -> [(String, String)] -> [Dependency] -> [Mixin] -> BuildInfo)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text
-> ObjectCodec
     (PerCompilerFlavor [String]) (PerCompilerFlavor [String])
forall output. HasCodec output => Text -> ObjectCodec output output
requiredField' Text
"sharedOptions" ObjectCodec
  (PerCompilerFlavor [String]) (PerCompilerFlavor [String])
-> (BuildInfo -> PerCompilerFlavor [String])
-> Codec Object BuildInfo (PerCompilerFlavor [String])
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
.= BuildInfo -> PerCompilerFlavor [String]
sharedOptions
        Codec
  Object
  BuildInfo
  (PerCompilerFlavor [String]
   -> [(String, String)] -> [Dependency] -> [Mixin] -> BuildInfo)
-> Codec Object BuildInfo (PerCompilerFlavor [String])
-> Codec
     Object
     BuildInfo
     ([(String, String)] -> [Dependency] -> [Mixin] -> BuildInfo)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text
-> ObjectCodec
     (PerCompilerFlavor [String]) (PerCompilerFlavor [String])
forall output. HasCodec output => Text -> ObjectCodec output output
requiredField' Text
"staticOptions" ObjectCodec
  (PerCompilerFlavor [String]) (PerCompilerFlavor [String])
-> (BuildInfo -> PerCompilerFlavor [String])
-> Codec Object BuildInfo (PerCompilerFlavor [String])
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
.= BuildInfo -> PerCompilerFlavor [String]
staticOptions
        Codec
  Object
  BuildInfo
  ([(String, String)] -> [Dependency] -> [Mixin] -> BuildInfo)
-> Codec Object BuildInfo [(String, String)]
-> Codec Object BuildInfo ([Dependency] -> [Mixin] -> BuildInfo)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text -> ObjectCodec [(String, String)] [(String, String)]
forall output. HasCodec output => Text -> ObjectCodec output output
requiredField' Text
"customFieldsBI" ObjectCodec [(String, String)] [(String, String)]
-> (BuildInfo -> [(String, String)])
-> Codec Object BuildInfo [(String, String)]
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
.= BuildInfo -> [(String, String)]
customFieldsBI
        Codec Object BuildInfo ([Dependency] -> [Mixin] -> BuildInfo)
-> Codec Object BuildInfo [Dependency]
-> Codec Object BuildInfo ([Mixin] -> BuildInfo)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text -> ObjectCodec [Dependency] [Dependency]
forall output. HasCodec output => Text -> ObjectCodec output output
requiredField' Text
"targetBuildDepends" ObjectCodec [Dependency] [Dependency]
-> (BuildInfo -> [Dependency])
-> Codec Object BuildInfo [Dependency]
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
.= BuildInfo -> [Dependency]
targetBuildDepends
        Codec Object BuildInfo ([Mixin] -> BuildInfo)
-> Codec Object BuildInfo [Mixin]
-> ObjectCodec BuildInfo BuildInfo
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text -> ObjectCodec [Mixin] [Mixin]
forall output. HasCodec output => Text -> ObjectCodec output output
requiredField' Text
"mixins" ObjectCodec [Mixin] [Mixin]
-> (BuildInfo -> [Mixin]) -> Codec Object BuildInfo [Mixin]
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
.= BuildInfo -> [Mixin]
mixins