{-|
  Copyright  :  (C) 2012-2016, University of Twente,
                    2016-2017, Myrtle Software Ltd
                    2018     , Google Inc.
                    2021     , QBayLogic B.V.
  License    :  BSD2 (see the file LICENSE)
  Maintainer :  QBayLogic B.V. <devops@qbaylogic.com>

  Type and instance definitions for Primitive
-}

{-# LANGUAGE CPP #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}

module Clash.Primitives.Types
  ( TemplateSource(..)
  , TemplateKind(..)
  , TemplateFormat(..)
  , BlackBoxFunctionName(..)
  , Primitive(..)
  , UsedArguments(..)
  , GuardedCompiledPrimitive
  , GuardedResolvedPrimitive
  , PrimMap
  , UnresolvedPrimitive
  , ResolvedPrimitive
  , ResolvedPrimMap
  , CompiledPrimitive
  , CompiledPrimMap
  ) where

import {-# SOURCE #-} Clash.Netlist.Types
import           Clash.Annotations.Primitive  (PrimitiveGuard)
import           Clash.Core.Term (WorkInfo (..))
import           Clash.Netlist.BlackBox.Types
  (BlackBoxFunction, BlackBoxTemplate, TemplateKind (..), RenderVoid(..))
import           Control.Applicative          ((<|>))
import           Control.DeepSeq              (NFData)
import           Data.Aeson
  (FromJSON (..), Value (..), (.:), (.:?), (.!=))
import           Data.Binary                  (Binary)
import           Data.Char                    (isUpper, isLower, isAlphaNum)
import           Data.Either                  (lefts)
import           Data.Hashable                (Hashable)
import qualified Data.HashMap.Strict          as H
import           Data.List                    (intercalate)
import qualified Data.Text                    as S
import           Data.Text.Lazy               (Text)
import           GHC.Generics                 (Generic)
import           GHC.Stack                    (HasCallStack)
import           Text.Read                    (readMaybe)

#if MIN_VERSION_aeson(2,0,0)
import qualified Data.Aeson.KeyMap as KeyMap
#endif

-- | An unresolved primitive still contains pointers to files.
type UnresolvedPrimitive = Primitive Text ((TemplateFormat,BlackBoxFunctionName),Maybe TemplateSource) (Maybe S.Text) (Maybe TemplateSource)

-- | A parsed primitive does not contain pointers to filesystem files anymore,
-- but holds uncompiled @BlackBoxTemplate@s and @BlackBoxFunction@s.
type ResolvedPrimitive        = Primitive Text ((TemplateFormat,BlackBoxFunctionName),Maybe Text) () (Maybe Text)
type GuardedResolvedPrimitive = PrimitiveGuard ResolvedPrimitive
type ResolvedPrimMap          = PrimMap GuardedResolvedPrimitive

-- | A compiled primitive has compiled all templates and functions from its
-- @ResolvedPrimitive@ counterpart. The Int in the tuple is a hash of the
-- (uncompiled) BlackBoxFunction.
type CompiledPrimitive        = Primitive BlackBoxTemplate BlackBox () (Int, BlackBoxFunction)
type GuardedCompiledPrimitive = PrimitiveGuard CompiledPrimitive
type CompiledPrimMap          = PrimMap GuardedCompiledPrimitive

-- | A @PrimMap@ maps primitive names to a @Primitive@
type PrimMap a = H.HashMap S.Text a

-- | A BBFN is a parsed version of a fully qualified function name. It is
-- guaranteed to have at least one module name which is not /Main/.
data BlackBoxFunctionName =
  BlackBoxFunctionName [String] String
    deriving (BlackBoxFunctionName -> BlackBoxFunctionName -> Bool
(BlackBoxFunctionName -> BlackBoxFunctionName -> Bool)
-> (BlackBoxFunctionName -> BlackBoxFunctionName -> Bool)
-> Eq BlackBoxFunctionName
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BlackBoxFunctionName -> BlackBoxFunctionName -> Bool
$c/= :: BlackBoxFunctionName -> BlackBoxFunctionName -> Bool
== :: BlackBoxFunctionName -> BlackBoxFunctionName -> Bool
$c== :: BlackBoxFunctionName -> BlackBoxFunctionName -> Bool
Eq, (forall x. BlackBoxFunctionName -> Rep BlackBoxFunctionName x)
-> (forall x. Rep BlackBoxFunctionName x -> BlackBoxFunctionName)
-> Generic BlackBoxFunctionName
forall x. Rep BlackBoxFunctionName x -> BlackBoxFunctionName
forall x. BlackBoxFunctionName -> Rep BlackBoxFunctionName x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep BlackBoxFunctionName x -> BlackBoxFunctionName
$cfrom :: forall x. BlackBoxFunctionName -> Rep BlackBoxFunctionName x
Generic, BlackBoxFunctionName -> ()
(BlackBoxFunctionName -> ()) -> NFData BlackBoxFunctionName
forall a. (a -> ()) -> NFData a
rnf :: BlackBoxFunctionName -> ()
$crnf :: BlackBoxFunctionName -> ()
NFData, Get BlackBoxFunctionName
[BlackBoxFunctionName] -> Put
BlackBoxFunctionName -> Put
(BlackBoxFunctionName -> Put)
-> Get BlackBoxFunctionName
-> ([BlackBoxFunctionName] -> Put)
-> Binary BlackBoxFunctionName
forall t. (t -> Put) -> Get t -> ([t] -> Put) -> Binary t
putList :: [BlackBoxFunctionName] -> Put
$cputList :: [BlackBoxFunctionName] -> Put
get :: Get BlackBoxFunctionName
$cget :: Get BlackBoxFunctionName
put :: BlackBoxFunctionName -> Put
$cput :: BlackBoxFunctionName -> Put
Binary, Eq BlackBoxFunctionName
Eq BlackBoxFunctionName
-> (Int -> BlackBoxFunctionName -> Int)
-> (BlackBoxFunctionName -> Int)
-> Hashable BlackBoxFunctionName
Int -> BlackBoxFunctionName -> Int
BlackBoxFunctionName -> Int
forall a. Eq a -> (Int -> a -> Int) -> (a -> Int) -> Hashable a
hash :: BlackBoxFunctionName -> Int
$chash :: BlackBoxFunctionName -> Int
hashWithSalt :: Int -> BlackBoxFunctionName -> Int
$chashWithSalt :: Int -> BlackBoxFunctionName -> Int
$cp1Hashable :: Eq BlackBoxFunctionName
Hashable)

instance Show BlackBoxFunctionName where
  show :: BlackBoxFunctionName -> String
show (BlackBoxFunctionName [String]
mods String
funcName) =
    String
"BBFN<" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
"." [String]
mods String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"." String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
funcName String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
">"

-- | Quick and dirty implementation of Text.splitOn for Strings
splitOn :: String -> String -> [String]
splitOn :: String -> String -> [String]
splitOn (String -> Text
S.pack -> Text
sep) (String -> Text
S.pack -> Text
str) =
  (Text -> String) -> [Text] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map Text -> String
S.unpack ([Text] -> [String]) -> [Text] -> [String]
forall a b. (a -> b) -> a -> b
$ Text -> Text -> [Text]
S.splitOn Text
sep Text
str

-- | Parses a string into a list of modules and a function name. I.e., it parses
-- the string 'Clash.Primitives.Types.parseBBFN' to
-- @["Clash", "Primitives",Types"]@ and @"parseBBFN"@.
-- The result is stored as a BlackBoxFunctionName.
parseBBFN
  :: HasCallStack
  => String
  -> Either String BlackBoxFunctionName
parseBBFN :: String -> Either String BlackBoxFunctionName
parseBBFN String
bbfn =
  case String -> String -> [String]
splitOn String
"." String
bbfn of
    []  -> String -> Either String BlackBoxFunctionName
forall a b. a -> Either a b
Left (String -> Either String BlackBoxFunctionName)
-> String -> Either String BlackBoxFunctionName
forall a b. (a -> b) -> a -> b
$ String
"Empty function name: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
bbfn
    [String
_] -> String -> Either String BlackBoxFunctionName
forall a b. a -> Either a b
Left (String -> Either String BlackBoxFunctionName)
-> String -> Either String BlackBoxFunctionName
forall a b. (a -> b) -> a -> b
$ String
"No module or function defined: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
bbfn
    [String]
nms ->
      let ([String]
mods, String
func) = ([String] -> [String]
forall a. [a] -> [a]
init [String]
nms, [String] -> String
forall a. [a] -> a
last [String]
nms) in
      let errs :: [String]
errs = [Either String String] -> [String]
forall a b. [Either a b] -> [a]
lefts ([Either String String] -> [String])
-> [Either String String] -> [String]
forall a b. (a -> b) -> a -> b
$ String -> Either String String
checkFunc String
func Either String String
-> [Either String String] -> [Either String String]
forall a. a -> [a] -> [a]
: (String -> Either String String)
-> [String] -> [Either String String]
forall a b. (a -> b) -> [a] -> [b]
map String -> Either String String
checkMod [String]
mods in
      case [String]
errs of
        [] -> BlackBoxFunctionName -> Either String BlackBoxFunctionName
forall a b. b -> Either a b
Right (BlackBoxFunctionName -> Either String BlackBoxFunctionName)
-> BlackBoxFunctionName -> Either String BlackBoxFunctionName
forall a b. (a -> b) -> a -> b
$ [String] -> String -> BlackBoxFunctionName
BlackBoxFunctionName [String]
mods String
func
        [String]
_  -> String -> Either String BlackBoxFunctionName
forall a b. a -> Either a b
Left (String -> Either String BlackBoxFunctionName)
-> String -> Either String BlackBoxFunctionName
forall a b. (a -> b) -> a -> b
$ String
"Error while parsing " String -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS
forall a. Show a => a -> String
show String
bbfn String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
": " String -> ShowS
forall a. [a] -> [a] -> [a]
++ [String] -> String
forall a. [a] -> a
head [String]
errs
  where
    checkMod :: String -> Either String String
checkMod String
mod'
      | Char -> Bool
isLower (String -> Char
forall a. [a] -> a
head String
mod') =
          String -> Either String String
forall a b. a -> Either a b
Left (String -> Either String String) -> String -> Either String String
forall a b. (a -> b) -> a -> b
$ String
"Module name cannot start with lowercase: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
mod'
      | (Char -> Bool) -> String -> Bool
forall (t :: Type -> Type) a.
Foldable t =>
(a -> Bool) -> t a -> Bool
any (Bool -> Bool
not (Bool -> Bool) -> (Char -> Bool) -> Char -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Bool
isAlphaNum) String
mod' =
          String -> Either String String
forall a b. a -> Either a b
Left (String -> Either String String) -> String -> Either String String
forall a b. (a -> b) -> a -> b
$ String
"Module name must be alphanumerical: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
mod'
      | Bool
otherwise =
          String -> Either String String
forall a b. b -> Either a b
Right String
mod'

    checkFunc :: String -> Either String String
checkFunc String
func
      | Char -> Bool
isUpper (String -> Char
forall a. [a] -> a
head String
func) =
          String -> Either String String
forall a b. a -> Either a b
Left (String -> Either String String) -> String -> Either String String
forall a b. (a -> b) -> a -> b
$ String
"Function name must start with lowercase: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
func
      | Bool
otherwise =
          String -> Either String String
forall a b. b -> Either a b
Right String
func

data TemplateSource
  = TFile FilePath
  -- ^ Template source stored in file on filesystem
  | TInline Text
  -- ^ Template stored inline
  deriving (Int -> TemplateSource -> ShowS
[TemplateSource] -> ShowS
TemplateSource -> String
(Int -> TemplateSource -> ShowS)
-> (TemplateSource -> String)
-> ([TemplateSource] -> ShowS)
-> Show TemplateSource
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TemplateSource] -> ShowS
$cshowList :: [TemplateSource] -> ShowS
show :: TemplateSource -> String
$cshow :: TemplateSource -> String
showsPrec :: Int -> TemplateSource -> ShowS
$cshowsPrec :: Int -> TemplateSource -> ShowS
Show, TemplateSource -> TemplateSource -> Bool
(TemplateSource -> TemplateSource -> Bool)
-> (TemplateSource -> TemplateSource -> Bool) -> Eq TemplateSource
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TemplateSource -> TemplateSource -> Bool
$c/= :: TemplateSource -> TemplateSource -> Bool
== :: TemplateSource -> TemplateSource -> Bool
$c== :: TemplateSource -> TemplateSource -> Bool
Eq, Eq TemplateSource
Eq TemplateSource
-> (Int -> TemplateSource -> Int)
-> (TemplateSource -> Int)
-> Hashable TemplateSource
Int -> TemplateSource -> Int
TemplateSource -> Int
forall a. Eq a -> (Int -> a -> Int) -> (a -> Int) -> Hashable a
hash :: TemplateSource -> Int
$chash :: TemplateSource -> Int
hashWithSalt :: Int -> TemplateSource -> Int
$chashWithSalt :: Int -> TemplateSource -> Int
$cp1Hashable :: Eq TemplateSource
Hashable, (forall x. TemplateSource -> Rep TemplateSource x)
-> (forall x. Rep TemplateSource x -> TemplateSource)
-> Generic TemplateSource
forall x. Rep TemplateSource x -> TemplateSource
forall x. TemplateSource -> Rep TemplateSource x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep TemplateSource x -> TemplateSource
$cfrom :: forall x. TemplateSource -> Rep TemplateSource x
Generic, TemplateSource -> ()
(TemplateSource -> ()) -> NFData TemplateSource
forall a. (a -> ()) -> NFData a
rnf :: TemplateSource -> ()
$crnf :: TemplateSource -> ()
NFData)


data TemplateFormat
  = TTemplate
  | THaskell
  deriving (Int -> TemplateFormat -> ShowS
[TemplateFormat] -> ShowS
TemplateFormat -> String
(Int -> TemplateFormat -> ShowS)
-> (TemplateFormat -> String)
-> ([TemplateFormat] -> ShowS)
-> Show TemplateFormat
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TemplateFormat] -> ShowS
$cshowList :: [TemplateFormat] -> ShowS
show :: TemplateFormat -> String
$cshow :: TemplateFormat -> String
showsPrec :: Int -> TemplateFormat -> ShowS
$cshowsPrec :: Int -> TemplateFormat -> ShowS
Show, (forall x. TemplateFormat -> Rep TemplateFormat x)
-> (forall x. Rep TemplateFormat x -> TemplateFormat)
-> Generic TemplateFormat
forall x. Rep TemplateFormat x -> TemplateFormat
forall x. TemplateFormat -> Rep TemplateFormat x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep TemplateFormat x -> TemplateFormat
$cfrom :: forall x. TemplateFormat -> Rep TemplateFormat x
Generic, TemplateFormat -> TemplateFormat -> Bool
(TemplateFormat -> TemplateFormat -> Bool)
-> (TemplateFormat -> TemplateFormat -> Bool) -> Eq TemplateFormat
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TemplateFormat -> TemplateFormat -> Bool
$c/= :: TemplateFormat -> TemplateFormat -> Bool
== :: TemplateFormat -> TemplateFormat -> Bool
$c== :: TemplateFormat -> TemplateFormat -> Bool
Eq, Eq TemplateFormat
Eq TemplateFormat
-> (Int -> TemplateFormat -> Int)
-> (TemplateFormat -> Int)
-> Hashable TemplateFormat
Int -> TemplateFormat -> Int
TemplateFormat -> Int
forall a. Eq a -> (Int -> a -> Int) -> (a -> Int) -> Hashable a
hash :: TemplateFormat -> Int
$chash :: TemplateFormat -> Int
hashWithSalt :: Int -> TemplateFormat -> Int
$chashWithSalt :: Int -> TemplateFormat -> Int
$cp1Hashable :: Eq TemplateFormat
Hashable, TemplateFormat -> ()
(TemplateFormat -> ()) -> NFData TemplateFormat
forall a. (a -> ()) -> NFData a
rnf :: TemplateFormat -> ()
$crnf :: TemplateFormat -> ()
NFData)

-- | Data type to indicate what arguments are in use by a BlackBox
data UsedArguments
  = UsedArguments [Int]
  -- ^ Only these are used
  | IgnoredArguments [Int]
  -- ^ All but these are used
  deriving (Int -> UsedArguments -> ShowS
[UsedArguments] -> ShowS
UsedArguments -> String
(Int -> UsedArguments -> ShowS)
-> (UsedArguments -> String)
-> ([UsedArguments] -> ShowS)
-> Show UsedArguments
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UsedArguments] -> ShowS
$cshowList :: [UsedArguments] -> ShowS
show :: UsedArguments -> String
$cshow :: UsedArguments -> String
showsPrec :: Int -> UsedArguments -> ShowS
$cshowsPrec :: Int -> UsedArguments -> ShowS
Show, (forall x. UsedArguments -> Rep UsedArguments x)
-> (forall x. Rep UsedArguments x -> UsedArguments)
-> Generic UsedArguments
forall x. Rep UsedArguments x -> UsedArguments
forall x. UsedArguments -> Rep UsedArguments x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep UsedArguments x -> UsedArguments
$cfrom :: forall x. UsedArguments -> Rep UsedArguments x
Generic, UsedArguments -> UsedArguments -> Bool
(UsedArguments -> UsedArguments -> Bool)
-> (UsedArguments -> UsedArguments -> Bool) -> Eq UsedArguments
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UsedArguments -> UsedArguments -> Bool
$c/= :: UsedArguments -> UsedArguments -> Bool
== :: UsedArguments -> UsedArguments -> Bool
$c== :: UsedArguments -> UsedArguments -> Bool
Eq, Eq UsedArguments
Eq UsedArguments
-> (Int -> UsedArguments -> Int)
-> (UsedArguments -> Int)
-> Hashable UsedArguments
Int -> UsedArguments -> Int
UsedArguments -> Int
forall a. Eq a -> (Int -> a -> Int) -> (a -> Int) -> Hashable a
hash :: UsedArguments -> Int
$chash :: UsedArguments -> Int
hashWithSalt :: Int -> UsedArguments -> Int
$chashWithSalt :: Int -> UsedArguments -> Int
$cp1Hashable :: Eq UsedArguments
Hashable, UsedArguments -> ()
(UsedArguments -> ()) -> NFData UsedArguments
forall a. (a -> ()) -> NFData a
rnf :: UsedArguments -> ()
$crnf :: UsedArguments -> ()
NFData, Get UsedArguments
[UsedArguments] -> Put
UsedArguments -> Put
(UsedArguments -> Put)
-> Get UsedArguments
-> ([UsedArguments] -> Put)
-> Binary UsedArguments
forall t. (t -> Put) -> Get t -> ([t] -> Put) -> Binary t
putList :: [UsedArguments] -> Put
$cputList :: [UsedArguments] -> Put
get :: Get UsedArguments
$cget :: Get UsedArguments
put :: UsedArguments -> Put
$cput :: UsedArguments -> Put
Binary)

-- | Externally defined primitive
data Primitive a b c d
  -- | Primitive template written in a Clash specific templating language
  = BlackBox
  { Primitive a b c d -> Text
name      :: !S.Text
    -- ^ Name of the primitive
  , Primitive a b c d -> WorkInfo
workInfo  :: WorkInfo
    -- ^ Whether the primitive does any work, i.e. takes chip area
  , Primitive a b c d -> RenderVoid
renderVoid :: RenderVoid
    -- ^ Whether this primitive should be rendered when its result type is
    -- void. Defaults to 'NoRenderVoid'.
  , Primitive a b c d -> Bool
multiResult :: Bool
    -- ^ Wether this blackbox assigns its results to multiple variables. See
    -- 'Clash.Normalize.Transformations.setupMultiResultPrim'
  , Primitive a b c d -> TemplateKind
kind      :: TemplateKind
    -- ^ Whether this results in an expression or a declaration
  , Primitive a b c d -> c
warning  :: c
    -- ^ A warning to be outputted when the primitive is instantiated.
    -- This is intended to be used as a warning for primitives that are not
    -- synthesizable, but may also be used for other purposes.
  , Primitive a b c d -> Bool
outputReg :: Bool
    -- ^ Verilog only: whether the result should be a /reg/(@True@) or /wire/
    -- (@False@); when not specified in the /.primitives/ file, the value will default
    -- to @False@ (i.e. /wire/).
  , Primitive a b c d -> [a]
libraries :: [a]
    -- ^ VHDL only: add /library/ declarations for the given names
  , Primitive a b c d -> [a]
imports   :: [a]
    -- ^ VHDL only: add /use/ declarations for the given names
  , Primitive a b c d -> [(Int, Int)]
functionPlurality :: [(Int, Int)]  -- Using map ruins Hashable instance
    -- ^ Indicates how often a function will be instantiated in a blackbox. For
    -- example, consider the following higher-order function that creates a tree
    -- structure:
    --
    --   fold :: (a -> a -> a) -> Vec n a -> a
    --
    -- In order to generate HDL for an instance of fold we need log2(n) calls
    -- to the first argument, `a -> a -> a` (plus a few more if n is not a
    -- power of two). Note that this only targets multiple textual instances
    -- of the function. If you can generate the HDL using a for-loop and only
    -- need to call ~INST once, you don't have to worry about this option. See
    -- the blackbox for 'Clash.Sized.Vector.map' for an example of this.
    --
    -- Right now, option can only be generated by BlackBoxHaskell. It cannot be
    -- used within JSON primitives. To see how to use this, see the Haskell
    -- blackbox for 'Clash.Sized.Vector.fold'.
  , Primitive a b c d -> [((Text, Text), b)]
includes  :: [((S.Text,S.Text),b)]
    -- ^ Create files to be included with the generated primitive. The fields
    -- are ((name, extension), content), where content is a template of the file
    -- Defaults to @[]@ when not specified in the /.primitives/ file
  , Primitive a b c d -> [b]
resultNames :: [b]
    -- ^ (Maybe) Control the generated name of the result
  , Primitive a b c d -> [b]
resultInits :: [b]
    -- ^ (Maybe) Control the initial/power-up value of the result
  , Primitive a b c d -> b
template :: b
    -- ^ Used to indiciate type of template (declaration or expression). Will be
    -- filled with @Template@ or an @Either decl expr@.
  }
  -- | Primitive template rendered by a Haskell function (given as raw source code)
  | BlackBoxHaskell
  { name :: !S.Text
    -- ^ Name of the primitive
  , workInfo  :: WorkInfo
    -- ^ Whether the primitive does any work, i.e. takes chip area
  , Primitive a b c d -> UsedArguments
usedArguments :: UsedArguments
  -- ^ Arguments used by blackbox. Used to remove arguments during normalization.
  , multiResult :: Bool
  -- ^ Wether this blackbox assigns its results to multiple variables. See
  -- 'Clash.Normalize.Transformations.setupMultiResultPrim'
  , Primitive a b c d -> BlackBoxFunctionName
functionName :: BlackBoxFunctionName
  , Primitive a b c d -> d
function :: d
  -- ^ Holds blackbox function and its hash, (Int, BlackBoxFunction), in a
  -- CompiledPrimitive.
  }
  -- | A primitive that carries additional information. These are "real"
  -- primitives, hardcoded in the compiler. For example: 'mapSignal' in
  -- @GHC2Core.coreToTerm@.
  | Primitive
  { name     :: !S.Text
    -- ^ Name of the primitive
  , workInfo  :: WorkInfo
    -- ^ Whether the primitive does any work, i.e. takes chip area
  , Primitive a b c d -> Text
primSort :: !Text
    -- ^ Additional information
  }
  deriving (Int -> Primitive a b c d -> ShowS
[Primitive a b c d] -> ShowS
Primitive a b c d -> String
(Int -> Primitive a b c d -> ShowS)
-> (Primitive a b c d -> String)
-> ([Primitive a b c d] -> ShowS)
-> Show (Primitive a b c d)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall a b c d.
(Show c, Show a, Show b, Show d) =>
Int -> Primitive a b c d -> ShowS
forall a b c d.
(Show c, Show a, Show b, Show d) =>
[Primitive a b c d] -> ShowS
forall a b c d.
(Show c, Show a, Show b, Show d) =>
Primitive a b c d -> String
showList :: [Primitive a b c d] -> ShowS
$cshowList :: forall a b c d.
(Show c, Show a, Show b, Show d) =>
[Primitive a b c d] -> ShowS
show :: Primitive a b c d -> String
$cshow :: forall a b c d.
(Show c, Show a, Show b, Show d) =>
Primitive a b c d -> String
showsPrec :: Int -> Primitive a b c d -> ShowS
$cshowsPrec :: forall a b c d.
(Show c, Show a, Show b, Show d) =>
Int -> Primitive a b c d -> ShowS
Show, (forall x. Primitive a b c d -> Rep (Primitive a b c d) x)
-> (forall x. Rep (Primitive a b c d) x -> Primitive a b c d)
-> Generic (Primitive a b c d)
forall x. Rep (Primitive a b c d) x -> Primitive a b c d
forall x. Primitive a b c d -> Rep (Primitive a b c d) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a b c d x. Rep (Primitive a b c d) x -> Primitive a b c d
forall a b c d x. Primitive a b c d -> Rep (Primitive a b c d) x
$cto :: forall a b c d x. Rep (Primitive a b c d) x -> Primitive a b c d
$cfrom :: forall a b c d x. Primitive a b c d -> Rep (Primitive a b c d) x
Generic, Primitive a b c d -> ()
(Primitive a b c d -> ()) -> NFData (Primitive a b c d)
forall a. (a -> ()) -> NFData a
forall a b c d.
(NFData c, NFData a, NFData b, NFData d) =>
Primitive a b c d -> ()
rnf :: Primitive a b c d -> ()
$crnf :: forall a b c d.
(NFData c, NFData a, NFData b, NFData d) =>
Primitive a b c d -> ()
NFData, Get (Primitive a b c d)
[Primitive a b c d] -> Put
Primitive a b c d -> Put
(Primitive a b c d -> Put)
-> Get (Primitive a b c d)
-> ([Primitive a b c d] -> Put)
-> Binary (Primitive a b c d)
forall t. (t -> Put) -> Get t -> ([t] -> Put) -> Binary t
forall a b c d.
(Binary c, Binary a, Binary b, Binary d) =>
Get (Primitive a b c d)
forall a b c d.
(Binary c, Binary a, Binary b, Binary d) =>
[Primitive a b c d] -> Put
forall a b c d.
(Binary c, Binary a, Binary b, Binary d) =>
Primitive a b c d -> Put
putList :: [Primitive a b c d] -> Put
$cputList :: forall a b c d.
(Binary c, Binary a, Binary b, Binary d) =>
[Primitive a b c d] -> Put
get :: Get (Primitive a b c d)
$cget :: forall a b c d.
(Binary c, Binary a, Binary b, Binary d) =>
Get (Primitive a b c d)
put :: Primitive a b c d -> Put
$cput :: forall a b c d.
(Binary c, Binary a, Binary b, Binary d) =>
Primitive a b c d -> Put
Binary, Primitive a b c d -> Primitive a b c d -> Bool
(Primitive a b c d -> Primitive a b c d -> Bool)
-> (Primitive a b c d -> Primitive a b c d -> Bool)
-> Eq (Primitive a b c d)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall a b c d.
(Eq c, Eq a, Eq b, Eq d) =>
Primitive a b c d -> Primitive a b c d -> Bool
/= :: Primitive a b c d -> Primitive a b c d -> Bool
$c/= :: forall a b c d.
(Eq c, Eq a, Eq b, Eq d) =>
Primitive a b c d -> Primitive a b c d -> Bool
== :: Primitive a b c d -> Primitive a b c d -> Bool
$c== :: forall a b c d.
(Eq c, Eq a, Eq b, Eq d) =>
Primitive a b c d -> Primitive a b c d -> Bool
Eq, Eq (Primitive a b c d)
Eq (Primitive a b c d)
-> (Int -> Primitive a b c d -> Int)
-> (Primitive a b c d -> Int)
-> Hashable (Primitive a b c d)
Int -> Primitive a b c d -> Int
Primitive a b c d -> Int
forall a. Eq a -> (Int -> a -> Int) -> (a -> Int) -> Hashable a
forall a b c d.
(Hashable c, Hashable a, Hashable b, Hashable d) =>
Eq (Primitive a b c d)
forall a b c d.
(Hashable c, Hashable a, Hashable b, Hashable d) =>
Int -> Primitive a b c d -> Int
forall a b c d.
(Hashable c, Hashable a, Hashable b, Hashable d) =>
Primitive a b c d -> Int
hash :: Primitive a b c d -> Int
$chash :: forall a b c d.
(Hashable c, Hashable a, Hashable b, Hashable d) =>
Primitive a b c d -> Int
hashWithSalt :: Int -> Primitive a b c d -> Int
$chashWithSalt :: forall a b c d.
(Hashable c, Hashable a, Hashable b, Hashable d) =>
Int -> Primitive a b c d -> Int
$cp1Hashable :: forall a b c d.
(Hashable c, Hashable a, Hashable b, Hashable d) =>
Eq (Primitive a b c d)
Hashable, a -> Primitive a b c b -> Primitive a b c a
(a -> b) -> Primitive a b c a -> Primitive a b c b
(forall a b. (a -> b) -> Primitive a b c a -> Primitive a b c b)
-> (forall a b. a -> Primitive a b c b -> Primitive a b c a)
-> Functor (Primitive a b c)
forall a b. a -> Primitive a b c b -> Primitive a b c a
forall a b. (a -> b) -> Primitive a b c a -> Primitive a b c b
forall a b c a b. a -> Primitive a b c b -> Primitive a b c a
forall a b c a b.
(a -> b) -> Primitive a b c a -> Primitive a b c b
forall (f :: Type -> Type).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> Primitive a b c b -> Primitive a b c a
$c<$ :: forall a b c a b. a -> Primitive a b c b -> Primitive a b c a
fmap :: (a -> b) -> Primitive a b c a -> Primitive a b c b
$cfmap :: forall a b c a b.
(a -> b) -> Primitive a b c a -> Primitive a b c b
Functor)

instance FromJSON UnresolvedPrimitive where
  parseJSON :: Value -> Parser UnresolvedPrimitive
parseJSON (Object Object
v) =
#if MIN_VERSION_aeson(2,0,0)
    case Object -> [(Key, Value)]
forall v. KeyMap v -> [(Key, v)]
KeyMap.toList Object
v of
#else
    case H.toList v of
#endif
      [(Key
conKey,Object Object
conVal)] ->
        case Key
conKey of
          Key
"BlackBoxHaskell"  -> do
            Maybe [Int]
usedArguments <- Object
conVal Object -> Key -> Parser (Maybe [Int])
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"usedArguments"
            Maybe [Int]
ignoredArguments <- Object
conVal Object -> Key -> Parser (Maybe [Int])
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"ignoredArguments"
            UsedArguments
args <-
              case (Maybe [Int]
usedArguments, Maybe [Int]
ignoredArguments) of
                (Maybe [Int]
Nothing, Maybe [Int]
Nothing) -> UsedArguments -> Parser UsedArguments
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure ([Int] -> UsedArguments
IgnoredArguments [])
                (Just [Int]
a, Maybe [Int]
Nothing) -> UsedArguments -> Parser UsedArguments
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure ([Int] -> UsedArguments
UsedArguments [Int]
a)
                (Maybe [Int]
Nothing, Just [Int]
a) -> UsedArguments -> Parser UsedArguments
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure ([Int] -> UsedArguments
IgnoredArguments [Int]
a)
                (Just [Int]
_, Just [Int]
_) ->
                  String -> Parser UsedArguments
forall (m :: Type -> Type) a. MonadFail m => String -> m a
fail String
"[8] Don't use both 'usedArguments' and 'ignoredArguments'"

            Text
name' <- Object
conVal Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"name"
            WorkInfo
wf    <- ((Object
conVal Object -> Key -> Parser (Maybe Value)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"workInfo" Parser (Maybe Value)
-> (Maybe Value -> Parser (Maybe WorkInfo))
-> Parser (Maybe WorkInfo)
forall (m :: Type -> Type) a b. Monad m => m a -> (a -> m b) -> m b
>>= Parser (Maybe WorkInfo)
-> (Value -> Parser (Maybe WorkInfo))
-> Maybe Value
-> Parser (Maybe WorkInfo)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Maybe WorkInfo -> Parser (Maybe WorkInfo)
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure Maybe WorkInfo
forall a. Maybe a
Nothing) Value -> Parser (Maybe WorkInfo)
forall (f :: Type -> Type).
MonadFail f =>
Value -> f (Maybe WorkInfo)
parseWorkInfo) Parser (Maybe WorkInfo) -> WorkInfo -> Parser WorkInfo
forall a. Parser (Maybe a) -> a -> Parser a
.!= WorkInfo
WorkVariable)
            String
fName <- Object
conVal Object -> Key -> Parser String
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"templateFunction"
            Bool
multiResult <- Object
conVal Object -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"multiResult" Parser (Maybe Bool) -> Bool -> Parser Bool
forall a. Parser (Maybe a) -> a -> Parser a
.!= Bool
False
            Maybe TemplateSource
templ <- (TemplateSource -> Maybe TemplateSource
forall a. a -> Maybe a
Just (TemplateSource -> Maybe TemplateSource)
-> (Text -> TemplateSource) -> Text -> Maybe TemplateSource
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> TemplateSource
TInline (Text -> Maybe TemplateSource)
-> Parser Text -> Parser (Maybe TemplateSource)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
conVal Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"template")
                 Parser (Maybe TemplateSource)
-> Parser (Maybe TemplateSource) -> Parser (Maybe TemplateSource)
forall (f :: Type -> Type) a. Alternative f => f a -> f a -> f a
<|> (TemplateSource -> Maybe TemplateSource
forall a. a -> Maybe a
Just (TemplateSource -> Maybe TemplateSource)
-> (String -> TemplateSource) -> String -> Maybe TemplateSource
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> TemplateSource
TFile   (String -> Maybe TemplateSource)
-> Parser String -> Parser (Maybe TemplateSource)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
conVal Object -> Key -> Parser String
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"file")
                 Parser (Maybe TemplateSource)
-> Parser (Maybe TemplateSource) -> Parser (Maybe TemplateSource)
forall (f :: Type -> Type) a. Alternative f => f a -> f a -> f a
<|> (Maybe TemplateSource -> Parser (Maybe TemplateSource)
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure Maybe TemplateSource
forall a. Maybe a
Nothing)
            BlackBoxFunctionName
fName' <- (String -> Parser BlackBoxFunctionName)
-> (BlackBoxFunctionName -> Parser BlackBoxFunctionName)
-> Either String BlackBoxFunctionName
-> Parser BlackBoxFunctionName
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either String -> Parser BlackBoxFunctionName
forall (m :: Type -> Type) a. MonadFail m => String -> m a
fail BlackBoxFunctionName -> Parser BlackBoxFunctionName
forall (m :: Type -> Type) a. Monad m => a -> m a
return (HasCallStack => String -> Either String BlackBoxFunctionName
String -> Either String BlackBoxFunctionName
parseBBFN String
fName)
            UnresolvedPrimitive -> Parser UnresolvedPrimitive
forall (m :: Type -> Type) a. Monad m => a -> m a
return (Text
-> WorkInfo
-> UsedArguments
-> Bool
-> BlackBoxFunctionName
-> Maybe TemplateSource
-> UnresolvedPrimitive
forall a b c d.
Text
-> WorkInfo
-> UsedArguments
-> Bool
-> BlackBoxFunctionName
-> d
-> Primitive a b c d
BlackBoxHaskell Text
name' WorkInfo
wf UsedArguments
args Bool
multiResult BlackBoxFunctionName
fName' Maybe TemplateSource
templ)
          Key
"BlackBox"  ->
            Text
-> WorkInfo
-> RenderVoid
-> Bool
-> TemplateKind
-> Maybe Text
-> Bool
-> [Text]
-> [Text]
-> [(Int, Int)]
-> [((Text, Text),
     ((TemplateFormat, BlackBoxFunctionName), Maybe TemplateSource))]
-> [((TemplateFormat, BlackBoxFunctionName), Maybe TemplateSource)]
-> [((TemplateFormat, BlackBoxFunctionName), Maybe TemplateSource)]
-> ((TemplateFormat, BlackBoxFunctionName), Maybe TemplateSource)
-> UnresolvedPrimitive
forall a b c d.
Text
-> WorkInfo
-> RenderVoid
-> Bool
-> TemplateKind
-> c
-> Bool
-> [a]
-> [a]
-> [(Int, Int)]
-> [((Text, Text), b)]
-> [b]
-> [b]
-> b
-> Primitive a b c d
BlackBox (Text
 -> WorkInfo
 -> RenderVoid
 -> Bool
 -> TemplateKind
 -> Maybe Text
 -> Bool
 -> [Text]
 -> [Text]
 -> [(Int, Int)]
 -> [((Text, Text),
      ((TemplateFormat, BlackBoxFunctionName), Maybe TemplateSource))]
 -> [((TemplateFormat, BlackBoxFunctionName), Maybe TemplateSource)]
 -> [((TemplateFormat, BlackBoxFunctionName), Maybe TemplateSource)]
 -> ((TemplateFormat, BlackBoxFunctionName), Maybe TemplateSource)
 -> UnresolvedPrimitive)
-> Parser Text
-> Parser
     (WorkInfo
      -> RenderVoid
      -> Bool
      -> TemplateKind
      -> Maybe Text
      -> Bool
      -> [Text]
      -> [Text]
      -> [(Int, Int)]
      -> [((Text, Text),
           ((TemplateFormat, BlackBoxFunctionName), Maybe TemplateSource))]
      -> [((TemplateFormat, BlackBoxFunctionName), Maybe TemplateSource)]
      -> [((TemplateFormat, BlackBoxFunctionName), Maybe TemplateSource)]
      -> ((TemplateFormat, BlackBoxFunctionName), Maybe TemplateSource)
      -> UnresolvedPrimitive)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
conVal Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"name"
                     Parser
  (WorkInfo
   -> RenderVoid
   -> Bool
   -> TemplateKind
   -> Maybe Text
   -> Bool
   -> [Text]
   -> [Text]
   -> [(Int, Int)]
   -> [((Text, Text),
        ((TemplateFormat, BlackBoxFunctionName), Maybe TemplateSource))]
   -> [((TemplateFormat, BlackBoxFunctionName), Maybe TemplateSource)]
   -> [((TemplateFormat, BlackBoxFunctionName), Maybe TemplateSource)]
   -> ((TemplateFormat, BlackBoxFunctionName), Maybe TemplateSource)
   -> UnresolvedPrimitive)
-> Parser WorkInfo
-> Parser
     (RenderVoid
      -> Bool
      -> TemplateKind
      -> Maybe Text
      -> Bool
      -> [Text]
      -> [Text]
      -> [(Int, Int)]
      -> [((Text, Text),
           ((TemplateFormat, BlackBoxFunctionName), Maybe TemplateSource))]
      -> [((TemplateFormat, BlackBoxFunctionName), Maybe TemplateSource)]
      -> [((TemplateFormat, BlackBoxFunctionName), Maybe TemplateSource)]
      -> ((TemplateFormat, BlackBoxFunctionName), Maybe TemplateSource)
      -> UnresolvedPrimitive)
forall (f :: Type -> Type) a b.
Applicative f =>
f (a -> b) -> f a -> f b
<*> (Object
conVal Object -> Key -> Parser (Maybe Value)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"workInfo" Parser (Maybe Value)
-> (Maybe Value -> Parser (Maybe WorkInfo))
-> Parser (Maybe WorkInfo)
forall (m :: Type -> Type) a b. Monad m => m a -> (a -> m b) -> m b
>>= Parser (Maybe WorkInfo)
-> (Value -> Parser (Maybe WorkInfo))
-> Maybe Value
-> Parser (Maybe WorkInfo)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Maybe WorkInfo -> Parser (Maybe WorkInfo)
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure Maybe WorkInfo
forall a. Maybe a
Nothing) Value -> Parser (Maybe WorkInfo)
forall (f :: Type -> Type).
MonadFail f =>
Value -> f (Maybe WorkInfo)
parseWorkInfo) Parser (Maybe WorkInfo) -> WorkInfo -> Parser WorkInfo
forall a. Parser (Maybe a) -> a -> Parser a
.!= WorkInfo
WorkVariable
                     Parser
  (RenderVoid
   -> Bool
   -> TemplateKind
   -> Maybe Text
   -> Bool
   -> [Text]
   -> [Text]
   -> [(Int, Int)]
   -> [((Text, Text),
        ((TemplateFormat, BlackBoxFunctionName), Maybe TemplateSource))]
   -> [((TemplateFormat, BlackBoxFunctionName), Maybe TemplateSource)]
   -> [((TemplateFormat, BlackBoxFunctionName), Maybe TemplateSource)]
   -> ((TemplateFormat, BlackBoxFunctionName), Maybe TemplateSource)
   -> UnresolvedPrimitive)
-> Parser RenderVoid
-> Parser
     (Bool
      -> TemplateKind
      -> Maybe Text
      -> Bool
      -> [Text]
      -> [Text]
      -> [(Int, Int)]
      -> [((Text, Text),
           ((TemplateFormat, BlackBoxFunctionName), Maybe TemplateSource))]
      -> [((TemplateFormat, BlackBoxFunctionName), Maybe TemplateSource)]
      -> [((TemplateFormat, BlackBoxFunctionName), Maybe TemplateSource)]
      -> ((TemplateFormat, BlackBoxFunctionName), Maybe TemplateSource)
      -> UnresolvedPrimitive)
forall (f :: Type -> Type) a b.
Applicative f =>
f (a -> b) -> f a -> f b
<*> Object
conVal Object -> Key -> Parser (Maybe RenderVoid)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"renderVoid" Parser (Maybe RenderVoid) -> RenderVoid -> Parser RenderVoid
forall a. Parser (Maybe a) -> a -> Parser a
.!= RenderVoid
NoRenderVoid
                     Parser
  (Bool
   -> TemplateKind
   -> Maybe Text
   -> Bool
   -> [Text]
   -> [Text]
   -> [(Int, Int)]
   -> [((Text, Text),
        ((TemplateFormat, BlackBoxFunctionName), Maybe TemplateSource))]
   -> [((TemplateFormat, BlackBoxFunctionName), Maybe TemplateSource)]
   -> [((TemplateFormat, BlackBoxFunctionName), Maybe TemplateSource)]
   -> ((TemplateFormat, BlackBoxFunctionName), Maybe TemplateSource)
   -> UnresolvedPrimitive)
-> Parser Bool
-> Parser
     (TemplateKind
      -> Maybe Text
      -> Bool
      -> [Text]
      -> [Text]
      -> [(Int, Int)]
      -> [((Text, Text),
           ((TemplateFormat, BlackBoxFunctionName), Maybe TemplateSource))]
      -> [((TemplateFormat, BlackBoxFunctionName), Maybe TemplateSource)]
      -> [((TemplateFormat, BlackBoxFunctionName), Maybe TemplateSource)]
      -> ((TemplateFormat, BlackBoxFunctionName), Maybe TemplateSource)
      -> UnresolvedPrimitive)
forall (f :: Type -> Type) a b.
Applicative f =>
f (a -> b) -> f a -> f b
<*> Object
conVal Object -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"multiResult" Parser (Maybe Bool) -> Bool -> Parser Bool
forall a. Parser (Maybe a) -> a -> Parser a
.!= Bool
False
                     Parser
  (TemplateKind
   -> Maybe Text
   -> Bool
   -> [Text]
   -> [Text]
   -> [(Int, Int)]
   -> [((Text, Text),
        ((TemplateFormat, BlackBoxFunctionName), Maybe TemplateSource))]
   -> [((TemplateFormat, BlackBoxFunctionName), Maybe TemplateSource)]
   -> [((TemplateFormat, BlackBoxFunctionName), Maybe TemplateSource)]
   -> ((TemplateFormat, BlackBoxFunctionName), Maybe TemplateSource)
   -> UnresolvedPrimitive)
-> Parser TemplateKind
-> Parser
     (Maybe Text
      -> Bool
      -> [Text]
      -> [Text]
      -> [(Int, Int)]
      -> [((Text, Text),
           ((TemplateFormat, BlackBoxFunctionName), Maybe TemplateSource))]
      -> [((TemplateFormat, BlackBoxFunctionName), Maybe TemplateSource)]
      -> [((TemplateFormat, BlackBoxFunctionName), Maybe TemplateSource)]
      -> ((TemplateFormat, BlackBoxFunctionName), Maybe TemplateSource)
      -> UnresolvedPrimitive)
forall (f :: Type -> Type) a b.
Applicative f =>
f (a -> b) -> f a -> f b
<*> (Object
conVal Object -> Key -> Parser Value
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"kind" Parser Value
-> (Value -> Parser TemplateKind) -> Parser TemplateKind
forall (m :: Type -> Type) a b. Monad m => m a -> (a -> m b) -> m b
>>= Value -> Parser TemplateKind
forall (f :: Type -> Type). MonadFail f => Value -> f TemplateKind
parseTemplateKind)
                     Parser
  (Maybe Text
   -> Bool
   -> [Text]
   -> [Text]
   -> [(Int, Int)]
   -> [((Text, Text),
        ((TemplateFormat, BlackBoxFunctionName), Maybe TemplateSource))]
   -> [((TemplateFormat, BlackBoxFunctionName), Maybe TemplateSource)]
   -> [((TemplateFormat, BlackBoxFunctionName), Maybe TemplateSource)]
   -> ((TemplateFormat, BlackBoxFunctionName), Maybe TemplateSource)
   -> UnresolvedPrimitive)
-> Parser (Maybe Text)
-> Parser
     (Bool
      -> [Text]
      -> [Text]
      -> [(Int, Int)]
      -> [((Text, Text),
           ((TemplateFormat, BlackBoxFunctionName), Maybe TemplateSource))]
      -> [((TemplateFormat, BlackBoxFunctionName), Maybe TemplateSource)]
      -> [((TemplateFormat, BlackBoxFunctionName), Maybe TemplateSource)]
      -> ((TemplateFormat, BlackBoxFunctionName), Maybe TemplateSource)
      -> UnresolvedPrimitive)
forall (f :: Type -> Type) a b.
Applicative f =>
f (a -> b) -> f a -> f b
<*> Object
conVal Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"warning"
                     Parser
  (Bool
   -> [Text]
   -> [Text]
   -> [(Int, Int)]
   -> [((Text, Text),
        ((TemplateFormat, BlackBoxFunctionName), Maybe TemplateSource))]
   -> [((TemplateFormat, BlackBoxFunctionName), Maybe TemplateSource)]
   -> [((TemplateFormat, BlackBoxFunctionName), Maybe TemplateSource)]
   -> ((TemplateFormat, BlackBoxFunctionName), Maybe TemplateSource)
   -> UnresolvedPrimitive)
-> Parser Bool
-> Parser
     ([Text]
      -> [Text]
      -> [(Int, Int)]
      -> [((Text, Text),
           ((TemplateFormat, BlackBoxFunctionName), Maybe TemplateSource))]
      -> [((TemplateFormat, BlackBoxFunctionName), Maybe TemplateSource)]
      -> [((TemplateFormat, BlackBoxFunctionName), Maybe TemplateSource)]
      -> ((TemplateFormat, BlackBoxFunctionName), Maybe TemplateSource)
      -> UnresolvedPrimitive)
forall (f :: Type -> Type) a b.
Applicative f =>
f (a -> b) -> f a -> f b
<*> Object
conVal Object -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"outputReg" Parser (Maybe Bool) -> Bool -> Parser Bool
forall a. Parser (Maybe a) -> a -> Parser a
.!= Bool
False
                     Parser
  ([Text]
   -> [Text]
   -> [(Int, Int)]
   -> [((Text, Text),
        ((TemplateFormat, BlackBoxFunctionName), Maybe TemplateSource))]
   -> [((TemplateFormat, BlackBoxFunctionName), Maybe TemplateSource)]
   -> [((TemplateFormat, BlackBoxFunctionName), Maybe TemplateSource)]
   -> ((TemplateFormat, BlackBoxFunctionName), Maybe TemplateSource)
   -> UnresolvedPrimitive)
-> Parser [Text]
-> Parser
     ([Text]
      -> [(Int, Int)]
      -> [((Text, Text),
           ((TemplateFormat, BlackBoxFunctionName), Maybe TemplateSource))]
      -> [((TemplateFormat, BlackBoxFunctionName), Maybe TemplateSource)]
      -> [((TemplateFormat, BlackBoxFunctionName), Maybe TemplateSource)]
      -> ((TemplateFormat, BlackBoxFunctionName), Maybe TemplateSource)
      -> UnresolvedPrimitive)
forall (f :: Type -> Type) a b.
Applicative f =>
f (a -> b) -> f a -> f b
<*> Object
conVal Object -> Key -> Parser (Maybe [Text])
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"libraries" Parser (Maybe [Text]) -> [Text] -> Parser [Text]
forall a. Parser (Maybe a) -> a -> Parser a
.!= []
                     Parser
  ([Text]
   -> [(Int, Int)]
   -> [((Text, Text),
        ((TemplateFormat, BlackBoxFunctionName), Maybe TemplateSource))]
   -> [((TemplateFormat, BlackBoxFunctionName), Maybe TemplateSource)]
   -> [((TemplateFormat, BlackBoxFunctionName), Maybe TemplateSource)]
   -> ((TemplateFormat, BlackBoxFunctionName), Maybe TemplateSource)
   -> UnresolvedPrimitive)
-> Parser [Text]
-> Parser
     ([(Int, Int)]
      -> [((Text, Text),
           ((TemplateFormat, BlackBoxFunctionName), Maybe TemplateSource))]
      -> [((TemplateFormat, BlackBoxFunctionName), Maybe TemplateSource)]
      -> [((TemplateFormat, BlackBoxFunctionName), Maybe TemplateSource)]
      -> ((TemplateFormat, BlackBoxFunctionName), Maybe TemplateSource)
      -> UnresolvedPrimitive)
forall (f :: Type -> Type) a b.
Applicative f =>
f (a -> b) -> f a -> f b
<*> Object
conVal Object -> Key -> Parser (Maybe [Text])
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"imports" Parser (Maybe [Text]) -> [Text] -> Parser [Text]
forall a. Parser (Maybe a) -> a -> Parser a
.!= []
                     Parser
  ([(Int, Int)]
   -> [((Text, Text),
        ((TemplateFormat, BlackBoxFunctionName), Maybe TemplateSource))]
   -> [((TemplateFormat, BlackBoxFunctionName), Maybe TemplateSource)]
   -> [((TemplateFormat, BlackBoxFunctionName), Maybe TemplateSource)]
   -> ((TemplateFormat, BlackBoxFunctionName), Maybe TemplateSource)
   -> UnresolvedPrimitive)
-> Parser [(Int, Int)]
-> Parser
     ([((Text, Text),
        ((TemplateFormat, BlackBoxFunctionName), Maybe TemplateSource))]
      -> [((TemplateFormat, BlackBoxFunctionName), Maybe TemplateSource)]
      -> [((TemplateFormat, BlackBoxFunctionName), Maybe TemplateSource)]
      -> ((TemplateFormat, BlackBoxFunctionName), Maybe TemplateSource)
      -> UnresolvedPrimitive)
forall (f :: Type -> Type) a b.
Applicative f =>
f (a -> b) -> f a -> f b
<*> [(Int, Int)] -> Parser [(Int, Int)]
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure [] -- functionPlurality not supported in json
                     Parser
  ([((Text, Text),
     ((TemplateFormat, BlackBoxFunctionName), Maybe TemplateSource))]
   -> [((TemplateFormat, BlackBoxFunctionName), Maybe TemplateSource)]
   -> [((TemplateFormat, BlackBoxFunctionName), Maybe TemplateSource)]
   -> ((TemplateFormat, BlackBoxFunctionName), Maybe TemplateSource)
   -> UnresolvedPrimitive)
-> Parser
     [((Text, Text),
       ((TemplateFormat, BlackBoxFunctionName), Maybe TemplateSource))]
-> Parser
     ([((TemplateFormat, BlackBoxFunctionName), Maybe TemplateSource)]
      -> [((TemplateFormat, BlackBoxFunctionName), Maybe TemplateSource)]
      -> ((TemplateFormat, BlackBoxFunctionName), Maybe TemplateSource)
      -> UnresolvedPrimitive)
forall (f :: Type -> Type) a b.
Applicative f =>
f (a -> b) -> f a -> f b
<*> (Object
conVal Object -> Key -> Parser (Maybe [Object])
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"includes" Parser (Maybe [Object]) -> [Object] -> Parser [Object]
forall a. Parser (Maybe a) -> a -> Parser a
.!= [] Parser [Object]
-> ([Object]
    -> Parser
         [((Text, Text),
           ((TemplateFormat, BlackBoxFunctionName), Maybe TemplateSource))])
-> Parser
     [((Text, Text),
       ((TemplateFormat, BlackBoxFunctionName), Maybe TemplateSource))]
forall (m :: Type -> Type) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Object
 -> Parser
      ((Text, Text),
       ((TemplateFormat, BlackBoxFunctionName), Maybe TemplateSource)))
-> [Object]
-> Parser
     [((Text, Text),
       ((TemplateFormat, BlackBoxFunctionName), Maybe TemplateSource))]
forall (t :: Type -> Type) (f :: Type -> Type) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse Object
-> Parser
     ((Text, Text),
      ((TemplateFormat, BlackBoxFunctionName), Maybe TemplateSource))
forall a a.
(FromJSON a, FromJSON a) =>
Object
-> Parser
     ((a, a),
      ((TemplateFormat, BlackBoxFunctionName), Maybe TemplateSource))
parseInclude)
                     Parser
  ([((TemplateFormat, BlackBoxFunctionName), Maybe TemplateSource)]
   -> [((TemplateFormat, BlackBoxFunctionName), Maybe TemplateSource)]
   -> ((TemplateFormat, BlackBoxFunctionName), Maybe TemplateSource)
   -> UnresolvedPrimitive)
-> Parser
     [((TemplateFormat, BlackBoxFunctionName), Maybe TemplateSource)]
-> Parser
     ([((TemplateFormat, BlackBoxFunctionName), Maybe TemplateSource)]
      -> ((TemplateFormat, BlackBoxFunctionName), Maybe TemplateSource)
      -> UnresolvedPrimitive)
forall (f :: Type -> Type) a b.
Applicative f =>
f (a -> b) -> f a -> f b
<*> (Object
conVal Object -> Key -> Parser (Maybe Value)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"resultName" Parser (Maybe Value)
-> (Maybe Value
    -> Parser
         (Maybe
            [((TemplateFormat, BlackBoxFunctionName), Maybe TemplateSource)]))
-> Parser
     (Maybe
        [((TemplateFormat, BlackBoxFunctionName), Maybe TemplateSource)])
forall (m :: Type -> Type) a b. Monad m => m a -> (a -> m b) -> m b
>>= Parser
  (Maybe
     [((TemplateFormat, BlackBoxFunctionName), Maybe TemplateSource)])
-> (Value
    -> Parser
         (Maybe
            [((TemplateFormat, BlackBoxFunctionName), Maybe TemplateSource)]))
-> Maybe Value
-> Parser
     (Maybe
        [((TemplateFormat, BlackBoxFunctionName), Maybe TemplateSource)])
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Maybe
  [((TemplateFormat, BlackBoxFunctionName), Maybe TemplateSource)]
-> Parser
     (Maybe
        [((TemplateFormat, BlackBoxFunctionName), Maybe TemplateSource)])
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure Maybe
  [((TemplateFormat, BlackBoxFunctionName), Maybe TemplateSource)]
forall a. Maybe a
Nothing) Value
-> Parser
     (Maybe
        [((TemplateFormat, BlackBoxFunctionName), Maybe TemplateSource)])
forall (f :: Type -> Type).
Applicative f =>
Value
-> Parser
     (Maybe
        (f ((TemplateFormat, BlackBoxFunctionName), Maybe TemplateSource)))
parseResult) Parser
  (Maybe
     [((TemplateFormat, BlackBoxFunctionName), Maybe TemplateSource)])
-> [((TemplateFormat, BlackBoxFunctionName), Maybe TemplateSource)]
-> Parser
     [((TemplateFormat, BlackBoxFunctionName), Maybe TemplateSource)]
forall a. Parser (Maybe a) -> a -> Parser a
.!= []
                     Parser
  ([((TemplateFormat, BlackBoxFunctionName), Maybe TemplateSource)]
   -> ((TemplateFormat, BlackBoxFunctionName), Maybe TemplateSource)
   -> UnresolvedPrimitive)
-> Parser
     [((TemplateFormat, BlackBoxFunctionName), Maybe TemplateSource)]
-> Parser
     (((TemplateFormat, BlackBoxFunctionName), Maybe TemplateSource)
      -> UnresolvedPrimitive)
forall (f :: Type -> Type) a b.
Applicative f =>
f (a -> b) -> f a -> f b
<*> (Object
conVal Object -> Key -> Parser (Maybe Value)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"resultInit" Parser (Maybe Value)
-> (Maybe Value
    -> Parser
         (Maybe
            [((TemplateFormat, BlackBoxFunctionName), Maybe TemplateSource)]))
-> Parser
     (Maybe
        [((TemplateFormat, BlackBoxFunctionName), Maybe TemplateSource)])
forall (m :: Type -> Type) a b. Monad m => m a -> (a -> m b) -> m b
>>= Parser
  (Maybe
     [((TemplateFormat, BlackBoxFunctionName), Maybe TemplateSource)])
-> (Value
    -> Parser
         (Maybe
            [((TemplateFormat, BlackBoxFunctionName), Maybe TemplateSource)]))
-> Maybe Value
-> Parser
     (Maybe
        [((TemplateFormat, BlackBoxFunctionName), Maybe TemplateSource)])
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Maybe
  [((TemplateFormat, BlackBoxFunctionName), Maybe TemplateSource)]
-> Parser
     (Maybe
        [((TemplateFormat, BlackBoxFunctionName), Maybe TemplateSource)])
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure Maybe
  [((TemplateFormat, BlackBoxFunctionName), Maybe TemplateSource)]
forall a. Maybe a
Nothing) Value
-> Parser
     (Maybe
        [((TemplateFormat, BlackBoxFunctionName), Maybe TemplateSource)])
forall (f :: Type -> Type).
Applicative f =>
Value
-> Parser
     (Maybe
        (f ((TemplateFormat, BlackBoxFunctionName), Maybe TemplateSource)))
parseResult) Parser
  (Maybe
     [((TemplateFormat, BlackBoxFunctionName), Maybe TemplateSource)])
-> [((TemplateFormat, BlackBoxFunctionName), Maybe TemplateSource)]
-> Parser
     [((TemplateFormat, BlackBoxFunctionName), Maybe TemplateSource)]
forall a. Parser (Maybe a) -> a -> Parser a
.!= []
                     Parser
  (((TemplateFormat, BlackBoxFunctionName), Maybe TemplateSource)
   -> UnresolvedPrimitive)
-> Parser
     ((TemplateFormat, BlackBoxFunctionName), Maybe TemplateSource)
-> Parser UnresolvedPrimitive
forall (f :: Type -> Type) a b.
Applicative f =>
f (a -> b) -> f a -> f b
<*> Object
-> Parser
     ((TemplateFormat, BlackBoxFunctionName), Maybe TemplateSource)
parseTemplate Object
conVal
          Key
"Primitive" ->
            Text -> WorkInfo -> Text -> UnresolvedPrimitive
forall a b c d. Text -> WorkInfo -> Text -> Primitive a b c d
Primitive (Text -> WorkInfo -> Text -> UnresolvedPrimitive)
-> Parser Text -> Parser (WorkInfo -> Text -> UnresolvedPrimitive)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
conVal Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"name"
                      Parser (WorkInfo -> Text -> UnresolvedPrimitive)
-> Parser WorkInfo -> Parser (Text -> UnresolvedPrimitive)
forall (f :: Type -> Type) a b.
Applicative f =>
f (a -> b) -> f a -> f b
<*> (Object
conVal Object -> Key -> Parser (Maybe Value)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"workInfo" Parser (Maybe Value)
-> (Maybe Value -> Parser (Maybe WorkInfo))
-> Parser (Maybe WorkInfo)
forall (m :: Type -> Type) a b. Monad m => m a -> (a -> m b) -> m b
>>= Parser (Maybe WorkInfo)
-> (Value -> Parser (Maybe WorkInfo))
-> Maybe Value
-> Parser (Maybe WorkInfo)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Maybe WorkInfo -> Parser (Maybe WorkInfo)
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure Maybe WorkInfo
forall a. Maybe a
Nothing) Value -> Parser (Maybe WorkInfo)
forall (f :: Type -> Type).
MonadFail f =>
Value -> f (Maybe WorkInfo)
parseWorkInfo) Parser (Maybe WorkInfo) -> WorkInfo -> Parser WorkInfo
forall a. Parser (Maybe a) -> a -> Parser a
.!= WorkInfo
WorkVariable
                      Parser (Text -> UnresolvedPrimitive)
-> Parser Text -> Parser UnresolvedPrimitive
forall (f :: Type -> Type) a b.
Applicative f =>
f (a -> b) -> f a -> f b
<*> Object
conVal Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"primType"

          Key
e -> String -> Parser UnresolvedPrimitive
forall (m :: Type -> Type) a. MonadFail m => String -> m a
fail (String -> Parser UnresolvedPrimitive)
-> String -> Parser UnresolvedPrimitive
forall a b. (a -> b) -> a -> b
$ String
"[1] Expected: BlackBox or Primitive object, got: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Key -> String
forall a. Show a => a -> String
show Key
e
      [(Key, Value)]
e -> String -> Parser UnresolvedPrimitive
forall (m :: Type -> Type) a. MonadFail m => String -> m a
fail (String -> Parser UnresolvedPrimitive)
-> String -> Parser UnresolvedPrimitive
forall a b. (a -> b) -> a -> b
$ String
"[2] Expected: BlackBox or Primitive object, got: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ [(Key, Value)] -> String
forall a. Show a => a -> String
show [(Key, Value)]
e
    where
      parseTemplate :: Object
-> Parser
     ((TemplateFormat, BlackBoxFunctionName), Maybe TemplateSource)
parseTemplate Object
c =
        (,) ((TemplateFormat, BlackBoxFunctionName)
 -> Maybe TemplateSource
 -> ((TemplateFormat, BlackBoxFunctionName), Maybe TemplateSource))
-> Parser (TemplateFormat, BlackBoxFunctionName)
-> Parser
     (Maybe TemplateSource
      -> ((TemplateFormat, BlackBoxFunctionName), Maybe TemplateSource))
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> ((,) (TemplateFormat
 -> BlackBoxFunctionName -> (TemplateFormat, BlackBoxFunctionName))
-> Parser TemplateFormat
-> Parser
     (BlackBoxFunctionName -> (TemplateFormat, BlackBoxFunctionName))
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
c Object -> Key -> Parser (Maybe Value)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"format" Parser (Maybe Value)
-> (Maybe Value -> Parser (Maybe TemplateFormat))
-> Parser (Maybe TemplateFormat)
forall (m :: Type -> Type) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Value -> Parser TemplateFormat)
-> Maybe Value -> Parser (Maybe TemplateFormat)
forall (t :: Type -> Type) (f :: Type -> Type) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse Value -> Parser TemplateFormat
forall (f :: Type -> Type).
MonadFail f =>
Value -> f TemplateFormat
parseTemplateFormat) Parser (Maybe TemplateFormat)
-> TemplateFormat -> Parser TemplateFormat
forall a. Parser (Maybe a) -> a -> Parser a
.!= TemplateFormat
TTemplate
                     Parser
  (BlackBoxFunctionName -> (TemplateFormat, BlackBoxFunctionName))
-> Parser BlackBoxFunctionName
-> Parser (TemplateFormat, BlackBoxFunctionName)
forall (f :: Type -> Type) a b.
Applicative f =>
f (a -> b) -> f a -> f b
<*> (Object
c Object -> Key -> Parser (Maybe String)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"templateFunction" Parser (Maybe String)
-> (Maybe String -> Parser (Maybe BlackBoxFunctionName))
-> Parser (Maybe BlackBoxFunctionName)
forall (m :: Type -> Type) a b. Monad m => m a -> (a -> m b) -> m b
>>= (String -> Parser BlackBoxFunctionName)
-> Maybe String -> Parser (Maybe BlackBoxFunctionName)
forall (t :: Type -> Type) (f :: Type -> Type) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse String -> Parser BlackBoxFunctionName
parseBBFN') Parser (Maybe BlackBoxFunctionName)
-> BlackBoxFunctionName -> Parser BlackBoxFunctionName
forall a. Parser (Maybe a) -> a -> Parser a
.!= BlackBoxFunctionName
defTemplateFunction)
            Parser
  (Maybe TemplateSource
   -> ((TemplateFormat, BlackBoxFunctionName), Maybe TemplateSource))
-> Parser (Maybe TemplateSource)
-> Parser
     ((TemplateFormat, BlackBoxFunctionName), Maybe TemplateSource)
forall (f :: Type -> Type) a b.
Applicative f =>
f (a -> b) -> f a -> f b
<*> (TemplateSource -> Maybe TemplateSource
forall a. a -> Maybe a
Just (TemplateSource -> Maybe TemplateSource)
-> (Text -> TemplateSource) -> Text -> Maybe TemplateSource
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> TemplateSource
TInline (Text -> Maybe TemplateSource)
-> Parser Text -> Parser (Maybe TemplateSource)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
c Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"template" Parser (Maybe TemplateSource)
-> Parser (Maybe TemplateSource) -> Parser (Maybe TemplateSource)
forall (f :: Type -> Type) a. Alternative f => f a -> f a -> f a
<|>
                 TemplateSource -> Maybe TemplateSource
forall a. a -> Maybe a
Just (TemplateSource -> Maybe TemplateSource)
-> (String -> TemplateSource) -> String -> Maybe TemplateSource
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> TemplateSource
TFile   (String -> Maybe TemplateSource)
-> Parser String -> Parser (Maybe TemplateSource)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
c Object -> Key -> Parser String
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"file" Parser (Maybe TemplateSource)
-> Parser (Maybe TemplateSource) -> Parser (Maybe TemplateSource)
forall (f :: Type -> Type) a. Alternative f => f a -> f a -> f a
<|>
                 Maybe TemplateSource -> Parser (Maybe TemplateSource)
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure Maybe TemplateSource
forall a. Maybe a
Nothing)

      parseInclude :: Object
-> Parser
     ((a, a),
      ((TemplateFormat, BlackBoxFunctionName), Maybe TemplateSource))
parseInclude Object
c =
        (,) ((a, a)
 -> ((TemplateFormat, BlackBoxFunctionName), Maybe TemplateSource)
 -> ((a, a),
     ((TemplateFormat, BlackBoxFunctionName), Maybe TemplateSource)))
-> Parser (a, a)
-> Parser
     (((TemplateFormat, BlackBoxFunctionName), Maybe TemplateSource)
      -> ((a, a),
          ((TemplateFormat, BlackBoxFunctionName), Maybe TemplateSource)))
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> ((,) (a -> a -> (a, a)) -> Parser a -> Parser (a -> (a, a))
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
c Object -> Key -> Parser a
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"name" Parser (a -> (a, a)) -> Parser a -> Parser (a, a)
forall (f :: Type -> Type) a b.
Applicative f =>
f (a -> b) -> f a -> f b
<*> Object
c Object -> Key -> Parser a
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"extension")
            Parser
  (((TemplateFormat, BlackBoxFunctionName), Maybe TemplateSource)
   -> ((a, a),
       ((TemplateFormat, BlackBoxFunctionName), Maybe TemplateSource)))
-> Parser
     ((TemplateFormat, BlackBoxFunctionName), Maybe TemplateSource)
-> Parser
     ((a, a),
      ((TemplateFormat, BlackBoxFunctionName), Maybe TemplateSource))
forall (f :: Type -> Type) a b.
Applicative f =>
f (a -> b) -> f a -> f b
<*> Object
-> Parser
     ((TemplateFormat, BlackBoxFunctionName), Maybe TemplateSource)
parseTemplate Object
c

      parseTemplateKind :: Value -> f TemplateKind
parseTemplateKind (String Text
"Declaration") = TemplateKind -> f TemplateKind
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure TemplateKind
TDecl
      parseTemplateKind (String Text
"Expression")  = TemplateKind -> f TemplateKind
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure TemplateKind
TExpr
      parseTemplateKind Value
c = String -> f TemplateKind
forall (m :: Type -> Type) a. MonadFail m => String -> m a
fail (String
"[4] Expected: Declaration or Expression, got " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Value -> String
forall a. Show a => a -> String
show Value
c)

      parseTemplateFormat :: Value -> f TemplateFormat
parseTemplateFormat (String Text
"Template") = TemplateFormat -> f TemplateFormat
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure TemplateFormat
TTemplate
      parseTemplateFormat (String Text
"Haskell")  = TemplateFormat -> f TemplateFormat
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure TemplateFormat
THaskell
      parseTemplateFormat Value
c = String -> f TemplateFormat
forall (m :: Type -> Type) a. MonadFail m => String -> m a
fail (String
"[5] unexpected format: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Value -> String
forall a. Show a => a -> String
show Value
c)

      parseWorkInfo :: Value -> f (Maybe WorkInfo)
parseWorkInfo (String Text
"Constant") = Maybe WorkInfo -> f (Maybe WorkInfo)
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (WorkInfo -> Maybe WorkInfo
forall a. a -> Maybe a
Just WorkInfo
WorkConstant)
      parseWorkInfo (String Text
"Never")    = Maybe WorkInfo -> f (Maybe WorkInfo)
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (WorkInfo -> Maybe WorkInfo
forall a. a -> Maybe a
Just WorkInfo
WorkNever)
      parseWorkInfo (String Text
"Variable") = Maybe WorkInfo -> f (Maybe WorkInfo)
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (WorkInfo -> Maybe WorkInfo
forall a. a -> Maybe a
Just WorkInfo
WorkVariable)
      parseWorkInfo (String Text
"Always")   = Maybe WorkInfo -> f (Maybe WorkInfo)
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (WorkInfo -> Maybe WorkInfo
forall a. a -> Maybe a
Just WorkInfo
WorkAlways)
      parseWorkInfo (Value -> Maybe WorkInfo
parseWorkIdentity -> wi :: Maybe WorkInfo
wi@Just{}) = Maybe WorkInfo -> f (Maybe WorkInfo)
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure Maybe WorkInfo
wi
      parseWorkInfo Value
c = String -> f (Maybe WorkInfo)
forall (m :: Type -> Type) a. MonadFail m => String -> m a
fail (String
"[6] unexpected workInfo: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Value -> String
forall a. Show a => a -> String
show Value
c)

      parseWorkIdentity :: Value -> Maybe WorkInfo
parseWorkIdentity Value
arg = do
        String Text
str   <- Value -> Maybe Value
forall (m :: Type -> Type) a. Monad m => a -> m a
return Value
arg
        [String
iStr,String
xsStr] <- String -> [String]
words (String -> [String]) -> (Text -> String) -> Text -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
S.unpack (Text -> [String]) -> Maybe Text -> Maybe [String]
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Text -> Maybe Text
S.stripPrefix Text
"Identity" Text
str
        Int -> [Int] -> WorkInfo
WorkIdentity (Int -> [Int] -> WorkInfo)
-> Maybe Int -> Maybe ([Int] -> WorkInfo)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> Maybe Int
forall a. Read a => String -> Maybe a
readMaybe String
iStr Maybe ([Int] -> WorkInfo) -> Maybe [Int] -> Maybe WorkInfo
forall (f :: Type -> Type) a b.
Applicative f =>
f (a -> b) -> f a -> f b
<*> String -> Maybe [Int]
forall a. Read a => String -> Maybe a
readMaybe String
xsStr

      parseBBFN' :: String -> Parser BlackBoxFunctionName
parseBBFN' = (String -> Parser BlackBoxFunctionName)
-> (BlackBoxFunctionName -> Parser BlackBoxFunctionName)
-> Either String BlackBoxFunctionName
-> Parser BlackBoxFunctionName
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either String -> Parser BlackBoxFunctionName
forall (m :: Type -> Type) a. MonadFail m => String -> m a
fail BlackBoxFunctionName -> Parser BlackBoxFunctionName
forall (m :: Type -> Type) a. Monad m => a -> m a
return (Either String BlackBoxFunctionName -> Parser BlackBoxFunctionName)
-> (String -> Either String BlackBoxFunctionName)
-> String
-> Parser BlackBoxFunctionName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HasCallStack => String -> Either String BlackBoxFunctionName
String -> Either String BlackBoxFunctionName
parseBBFN

      defTemplateFunction :: BlackBoxFunctionName
defTemplateFunction = [String] -> String -> BlackBoxFunctionName
BlackBoxFunctionName [String
"Template"] String
"template"

      parseResult :: Value
-> Parser
     (Maybe
        (f ((TemplateFormat, BlackBoxFunctionName), Maybe TemplateSource)))
parseResult (Object Object
c) =
        f ((TemplateFormat, BlackBoxFunctionName), Maybe TemplateSource)
-> Maybe
     (f ((TemplateFormat, BlackBoxFunctionName), Maybe TemplateSource))
forall a. a -> Maybe a
Just (f ((TemplateFormat, BlackBoxFunctionName), Maybe TemplateSource)
 -> Maybe
      (f ((TemplateFormat, BlackBoxFunctionName), Maybe TemplateSource)))
-> (((TemplateFormat, BlackBoxFunctionName), Maybe TemplateSource)
    -> f ((TemplateFormat, BlackBoxFunctionName),
          Maybe TemplateSource))
-> ((TemplateFormat, BlackBoxFunctionName), Maybe TemplateSource)
-> Maybe
     (f ((TemplateFormat, BlackBoxFunctionName), Maybe TemplateSource))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((TemplateFormat, BlackBoxFunctionName), Maybe TemplateSource)
-> f ((TemplateFormat, BlackBoxFunctionName), Maybe TemplateSource)
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (((TemplateFormat, BlackBoxFunctionName), Maybe TemplateSource)
 -> Maybe
      (f ((TemplateFormat, BlackBoxFunctionName), Maybe TemplateSource)))
-> Parser
     ((TemplateFormat, BlackBoxFunctionName), Maybe TemplateSource)
-> Parser
     (Maybe
        (f ((TemplateFormat, BlackBoxFunctionName), Maybe TemplateSource)))
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
-> Parser
     ((TemplateFormat, BlackBoxFunctionName), Maybe TemplateSource)
parseTemplate Object
c
      parseResult Value
e = String
-> Parser
     (Maybe
        (f ((TemplateFormat, BlackBoxFunctionName), Maybe TemplateSource)))
forall (m :: Type -> Type) a. MonadFail m => String -> m a
fail (String
 -> Parser
      (Maybe
         (f ((TemplateFormat, BlackBoxFunctionName),
             Maybe TemplateSource))))
-> String
-> Parser
     (Maybe
        (f ((TemplateFormat, BlackBoxFunctionName), Maybe TemplateSource)))
forall a b. (a -> b) -> a -> b
$ String
"[7] unexpected result: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Value -> String
forall a. Show a => a -> String
show Value
e

  parseJSON Value
unexpected =
    String -> Parser UnresolvedPrimitive
forall (m :: Type -> Type) a. MonadFail m => String -> m a
fail (String -> Parser UnresolvedPrimitive)
-> String -> Parser UnresolvedPrimitive
forall a b. (a -> b) -> a -> b
$ String
"[3] Expected: BlackBox or Primitive object, got: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Value -> String
forall a. Show a => a -> String
show Value
unexpected