    {-|
      Copyright  :  (C) 2012-2016, University of Twente,
                        2016-2017, Myrtle Software Ltd
                        2018     , Google Inc.
                        2021     , QBayLogic B.V.
                        2022     , Google Inc.
      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 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 (BlackBox, Usage(..))
    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           Control.Monad                (when)
    import           Data.Aeson
      (FromJSON (..), Value (..), (.:), (.:?), (.!=))
    import           Data.Aeson.Types             (Parser)
    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           Data.Maybe                   (isJust)
    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
    $c== :: BlackBoxFunctionName -> BlackBoxFunctionName -> Bool
    == :: BlackBoxFunctionName -> BlackBoxFunctionName -> Bool
    $c/= :: BlackBoxFunctionName -> BlackBoxFunctionName -> Bool
    /= :: 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
    $cfrom :: forall x. BlackBoxFunctionName -> Rep BlackBoxFunctionName x
    from :: forall x. BlackBoxFunctionName -> Rep BlackBoxFunctionName x
    $cto :: forall x. Rep BlackBoxFunctionName x -> BlackBoxFunctionName
    to :: forall x. Rep BlackBoxFunctionName x -> BlackBoxFunctionName
    Generic, BlackBoxFunctionName -> ()
    (BlackBoxFunctionName -> ()) -> NFData BlackBoxFunctionName
    forall a. (a -> ()) -> NFData a
    $crnf :: BlackBoxFunctionName -> ()
    rnf :: 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
    $cput :: BlackBoxFunctionName -> Put
    put :: BlackBoxFunctionName -> Put
    $cget :: Get BlackBoxFunctionName
    get :: Get BlackBoxFunctionName
    $cputList :: [BlackBoxFunctionName] -> Put
    putList :: [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
    $chashWithSalt :: Int -> BlackBoxFunctionName -> Int
    hashWithSalt :: Int -> BlackBoxFunctionName -> Int
    $chash :: BlackBoxFunctionName -> Int
    hash :: BlackBoxFunctionName -> Int
    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
    $ HasCallStack => Text -> Text -> [Text]
    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 :: HasCallStack => 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. HasCallStack => [a] -> [a]
    init [String]
    nms, [String] -> String
    forall a. HasCallStack => [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
    e:[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
    e
      where
        checkMod :: String -> Either String String
    checkMod String
    mod'
          | Char
    m':String
    _ <- String
    mod'
          , Char -> Bool
    isLower Char
    m' =
              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
    f:String
    _ <- String
    func
          , Char -> Bool
    isUpper Char
    f =
              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
    $cshowsPrec :: Int -> TemplateSource -> ShowS
    showsPrec :: Int -> TemplateSource -> ShowS
    $cshow :: TemplateSource -> String
    show :: TemplateSource -> String
    $cshowList :: [TemplateSource] -> ShowS
    showList :: [TemplateSource] -> ShowS
    Show, TemplateSource -> TemplateSource -> Bool
    (TemplateSource -> TemplateSource -> Bool)
    -> (TemplateSource -> TemplateSource -> Bool) -> Eq TemplateSource
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: TemplateSource -> TemplateSource -> Bool
    == :: TemplateSource -> TemplateSource -> Bool
    $c/= :: TemplateSource -> TemplateSource -> Bool
    /= :: 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
    $chashWithSalt :: Int -> TemplateSource -> Int
    hashWithSalt :: Int -> TemplateSource -> Int
    $chash :: TemplateSource -> Int
    hash :: TemplateSource -> Int
    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
    $cfrom :: forall x. TemplateSource -> Rep TemplateSource x
    from :: forall x. TemplateSource -> Rep TemplateSource x
    $cto :: forall x. Rep TemplateSource x -> TemplateSource
    to :: forall x. Rep TemplateSource x -> TemplateSource
    Generic, TemplateSource -> ()
    (TemplateSource -> ()) -> NFData TemplateSource
    forall a. (a -> ()) -> NFData a
    $crnf :: TemplateSource -> ()
    rnf :: 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
    $cshowsPrec :: Int -> TemplateFormat -> ShowS
    showsPrec :: Int -> TemplateFormat -> ShowS
    $cshow :: TemplateFormat -> String
    show :: TemplateFormat -> String
    $cshowList :: [TemplateFormat] -> ShowS
    showList :: [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
    $cfrom :: forall x. TemplateFormat -> Rep TemplateFormat x
    from :: forall x. TemplateFormat -> Rep TemplateFormat x
    $cto :: forall x. Rep TemplateFormat x -> TemplateFormat
    to :: forall x. Rep TemplateFormat x -> TemplateFormat
    Generic, TemplateFormat -> TemplateFormat -> Bool
    (TemplateFormat -> TemplateFormat -> Bool)
    -> (TemplateFormat -> TemplateFormat -> Bool) -> Eq TemplateFormat
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: TemplateFormat -> TemplateFormat -> Bool
    == :: TemplateFormat -> TemplateFormat -> Bool
    $c/= :: TemplateFormat -> TemplateFormat -> Bool
    /= :: 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
    $chashWithSalt :: Int -> TemplateFormat -> Int
    hashWithSalt :: Int -> TemplateFormat -> Int
    $chash :: TemplateFormat -> Int
    hash :: TemplateFormat -> Int
    Hashable, TemplateFormat -> ()
    (TemplateFormat -> ()) -> NFData TemplateFormat
    forall a. (a -> ()) -> NFData a
    $crnf :: TemplateFormat -> ()
    rnf :: 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
    $cshowsPrec :: Int -> UsedArguments -> ShowS
    showsPrec :: Int -> UsedArguments -> ShowS
    $cshow :: UsedArguments -> String
    show :: UsedArguments -> String
    $cshowList :: [UsedArguments] -> ShowS
    showList :: [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
    $cfrom :: forall x. UsedArguments -> Rep UsedArguments x
    from :: forall x. UsedArguments -> Rep UsedArguments x
    $cto :: forall x. Rep UsedArguments x -> UsedArguments
    to :: forall x. Rep UsedArguments x -> UsedArguments
    Generic, UsedArguments -> UsedArguments -> Bool
    (UsedArguments -> UsedArguments -> Bool)
    -> (UsedArguments -> UsedArguments -> Bool) -> Eq UsedArguments
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: UsedArguments -> UsedArguments -> Bool
    == :: UsedArguments -> UsedArguments -> Bool
    $c/= :: UsedArguments -> UsedArguments -> Bool
    /= :: 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
    $chashWithSalt :: Int -> UsedArguments -> Int
    hashWithSalt :: Int -> UsedArguments -> Int
    $chash :: UsedArguments -> Int
    hash :: UsedArguments -> Int
    Hashable, UsedArguments -> ()
    (UsedArguments -> ()) -> NFData UsedArguments
    forall a. (a -> ()) -> NFData a
    $crnf :: UsedArguments -> ()
    rnf :: 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
    $cput :: UsedArguments -> Put
    put :: UsedArguments -> Put
    $cget :: Get UsedArguments
    get :: Get UsedArguments
    $cputList :: [UsedArguments] -> Put
    putList :: [UsedArguments] -> Put
    Binary)

    -- | Externally defined primitive
    data Primitive a b c d
      -- | Primitive template written in a Clash specific templating language
      = BlackBox
      { forall a b c d. Primitive a b c d -> Text
    name      :: !S.Text
        -- ^ Name of the primitive
      , forall a b c d. Primitive a b c d -> WorkInfo
    workInfo  :: WorkInfo
        -- ^ Whether the primitive does any work, i.e. takes chip area
      , forall a b c d. Primitive a b c d -> RenderVoid
    renderVoid :: RenderVoid
        -- ^ Whether this primitive should be rendered when its result type is
        -- void. Defaults to 'NoRenderVoid'.
      , forall a b c d. Primitive a b c d -> Bool
    multiResult :: Bool
        -- ^ Wether this blackbox assigns its results to multiple variables. See
        -- 'Clash.Normalize.Transformations.setupMultiResultPrim'
      , forall a b c d. Primitive a b c d -> TemplateKind
    kind      :: TemplateKind
        -- ^ Whether this results in an expression or a declaration
      , forall a b c d. 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.
      , forall a b c d. Primitive a b c d -> Usage
    outputUsage :: Usage
        -- ^ How the result is assigned in HDL. This is used to determine the
        -- type of declaration used to render the result (wire/reg or
        -- signal/variable). The default usage is continuous assignment.
      , forall a b c d. Primitive a b c d -> [a]
    libraries :: [a]
        -- ^ VHDL only: add /library/ declarations for the given names
      , forall a b c d. Primitive a b c d -> [a]
    imports   :: [a]
        -- ^ VHDL only: add /use/ declarations for the given names
      , forall a b c d. 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'.
      , forall a b c d. 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
      , forall a b c d. Primitive a b c d -> [b]
    resultNames :: [b]
        -- ^ (Maybe) Control the generated name of the result
      , forall a b c d. Primitive a b c d -> [b]
    resultInits :: [b]
        -- ^ (Maybe) Control the initial/power-up value of the result
      , forall a b c d. 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
      , forall a b c d. 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'
      , forall a b c d. Primitive a b c d -> BlackBoxFunctionName
    functionName :: BlackBoxFunctionName
      , forall a b c d. 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
      , forall a b c d. 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
    $cshowsPrec :: forall a b c d.
    (Show c, Show a, Show b, Show d) =>
    Int -> Primitive a b c d -> ShowS
    showsPrec :: Int -> Primitive a b c d -> ShowS
    $cshow :: forall a b c d.
    (Show c, Show a, Show b, Show d) =>
    Primitive a b c d -> String
    show :: Primitive a b c d -> String
    $cshowList :: forall a b c d.
    (Show c, Show a, Show b, Show d) =>
    [Primitive a b c d] -> ShowS
    showList :: [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
    $cfrom :: forall a b c d x. Primitive a b c d -> Rep (Primitive a b c d) x
    from :: forall 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
    to :: forall x. Rep (Primitive a b c d) x -> Primitive a b c d
    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 -> ()
    $crnf :: forall a b c d.
    (NFData c, NFData a, NFData b, NFData d) =>
    Primitive a b c d -> ()
    rnf :: 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
    $cput :: forall a b c d.
    (Binary c, Binary a, Binary b, Binary d) =>
    Primitive a b c d -> Put
    put :: Primitive a b c d -> Put
    $cget :: forall a b c d.
    (Binary c, Binary a, Binary b, Binary d) =>
    Get (Primitive a b c d)
    get :: Get (Primitive a b c d)
    $cputList :: 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
    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
    $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
    /= :: 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
    $chashWithSalt :: forall a b c d.
    (Hashable c, Hashable a, Hashable b, Hashable d) =>
    Int -> Primitive a b c d -> Int
    hashWithSalt :: Int -> 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
    hash :: Primitive a b c d -> Int
    Hashable, (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
    $cfmap :: forall a b c a b.
    (a -> b) -> Primitive a b c a -> Primitive a b c b
    fmap :: forall a b. (a -> b) -> Primitive a b c a -> Primitive a b c b
    $c<$ :: forall a b c a b. a -> Primitive a b c b -> Primitive a b c a
    <$ :: forall a b. a -> Primitive a b c b -> Primitive a b c a
    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
                usedArgs <- Object
    conVal Object -> Key -> Parser (Maybe [Int])
    forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
    .:? Key
    "usedArguments"
                ignoredArgs <- conVal .:? "ignoredArguments"
                args <-
                  case (usedArgs, ignoredArgs) of
                    (Maybe [Int]
    Nothing, Maybe [Int]
    Nothing) -> UsedArguments -> Parser UsedArguments
    forall a. a -> Parser a
    forall (f :: Type -> Type) a. Applicative f => a -> f a
    pure ([Int] -> UsedArguments
    IgnoredArguments [])
                    (Just [Int]
    a, Maybe [Int]
    Nothing) -> UsedArguments -> Parser UsedArguments
    forall a. a -> Parser a
    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 a. a -> Parser a
    forall (f :: Type -> Type) a. Applicative f => a -> f a
    pure ([Int] -> UsedArguments
    IgnoredArguments [Int]
    a)
                    (Just [Int]
    _, Just [Int]
    _) ->
                      String -> Parser UsedArguments
    forall a. String -> Parser a
    forall (m :: Type -> Type) a. MonadFail m => String -> m a
    fail String
    "[8] Don't use both 'usedArguments' and 'ignoredArguments'"

                name' <- conVal .: "name"
                wf    <- ((conVal .:? "workInfo" >>= maybe (pure Nothing) parseWorkInfo) .!= WorkVariable)
                fName <- conVal .: "templateFunction"
                isMultiResult <- conVal .:? "multiResult" .!= False
                templ <- (Just . TInline <$> conVal .: "template")
                     <|> (Just . TFile   <$> conVal .: "file")
                     <|> (pure Nothing)
                fName' <- either fail return (parseBBFN fName)
                return (BlackBoxHaskell name' wf args isMultiResult fName' templ)
              Key
    "BlackBox"  -> do
                outReg <- Object
    conVal Object -> Key -> Parser (Maybe Bool)
    forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
    .:? Key
    "outputReg" :: Parser (Maybe Bool)

                when (isJust outReg) .
                  fail $ mconcat
                    [ "[9] 'outputReg' is no longer a recognized key.\n"
                    , "Use 'outputUsage: Continuous|NonBlocking|Blocking' instead."
                    ]

                BlackBox <$> conVal .: "name"
                         <*> (conVal .:? "workInfo" >>= maybe (pure Nothing) parseWorkInfo) .!= WorkVariable
                         <*> conVal .:? "renderVoid" .!= NoRenderVoid
                         <*> conVal .:? "multiResult" .!= False
                         <*> (conVal .: "kind" >>= parseTemplateKind)
                         <*> conVal .:? "warning"
                         <*> conVal .:? "outputUsage" .!= Cont
                         <*> conVal .:? "libraries" .!= []
                         <*> conVal .:? "imports" .!= []
                         <*> pure [] -- functionPlurality not supported in json
                         <*> (conVal .:? "includes" .!= [] >>= traverse parseInclude)
                         <*> (conVal .:? "resultName" >>= maybe (pure Nothing) parseResult) .!= []
                         <*> (conVal .:? "resultInit" >>= maybe (pure Nothing) parseResult) .!= []
                         <*> parseTemplate 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 a b. Parser (a -> b) -> Parser a -> Parser b
    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 a b. Parser a -> (a -> Parser b) -> Parser b
    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 a. a -> Parser a
    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 a b. Parser (a -> b) -> Parser a -> Parser b
    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 a. String -> Parser a
    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 a. String -> Parser a
    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 a b. Parser a -> (a -> Parser b) -> Parser b
    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)
    forall (f :: Type -> Type) a b.
    Applicative f =>
    (a -> f b) -> Maybe a -> f (Maybe 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 a b. Parser (a -> b) -> Parser a -> Parser b
    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 a b. Parser a -> (a -> Parser b) -> Parser b
    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)
    forall (f :: Type -> Type) a b.
    Applicative f =>
    (a -> f b) -> Maybe a -> f (Maybe 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 a b. Parser (a -> b) -> Parser a -> Parser b
    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 a. Parser a -> Parser a -> Parser a
    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 a. Parser a -> Parser a -> Parser a
    forall (f :: Type -> Type) a. Alternative f => f a -> f a -> f a
    <|>
                     Maybe TemplateSource -> Parser (Maybe TemplateSource)
    forall a. a -> Parser a
    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 a b. Parser (a -> b) -> Parser a -> Parser b
    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 a b. Parser (a -> b) -> Parser a -> Parser b
    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 a. a -> f a
    forall (f :: Type -> Type) a. Applicative f => a -> f a
    pure TemplateKind
    TDecl
          parseTemplateKind (String Text
    "Expression")  = TemplateKind -> f TemplateKind
    forall a. a -> f a
    forall (f :: Type -> Type) a. Applicative f => a -> f a
    pure TemplateKind
    TExpr
          parseTemplateKind Value
    c = String -> f TemplateKind
    forall a. String -> f a
    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 a. a -> f a
    forall (f :: Type -> Type) a. Applicative f => a -> f a
    pure TemplateFormat
    TTemplate
          parseTemplateFormat (String Text
    "Haskell")  = TemplateFormat -> f TemplateFormat
    forall a. a -> f a
    forall (f :: Type -> Type) a. Applicative f => a -> f a
    pure TemplateFormat
    THaskell
          parseTemplateFormat Value
    c = String -> f TemplateFormat
    forall a. String -> f a
    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 a. a -> f a
    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 a. a -> f a
    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 a. a -> f a
    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 a. a -> f a
    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 a. a -> f a
    forall (f :: Type -> Type) a. Applicative f => a -> f a
    pure Maybe WorkInfo
    wi
          parseWorkInfo Value
    c = String -> f (Maybe WorkInfo)
    forall a. String -> f a
    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 str   <- Value -> Maybe Value
    forall a. a -> Maybe a
    forall (m :: Type -> Type) a. Monad m => a -> m a
    return Value
    arg
            [iStr,xsStr] <- words . S.unpack <$> S.stripPrefix "Identity" str
            WorkIdentity <$> readMaybe iStr <*> readMaybe 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 a. String -> Parser a
    forall (m :: Type -> Type) a. MonadFail m => String -> m a
    fail BlackBoxFunctionName -> Parser BlackBoxFunctionName
    forall a. a -> Parser a
    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 a. a -> f a
    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 a. String -> Parser a
    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 a. String -> Parser a
    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