{-|
  Copyright  :  (C) 2012-2016, University of Twente,
                    2016-2017, Myrtle Software Ltd
                    2018     , Google Inc.
  License    :  BSD2 (see the file LICENSE)
  Maintainer :  Christiaan Baaij <christiaan.baaij@gmail.com>

  Type and instance definitions for Primitive
-}

{-# LANGUAGE DeriveAnyClass    #-}
{-# LANGUAGE DeriveFunctor     #-}
{-# LANGUAGE DeriveFoldable    #-}
{-# LANGUAGE DeriveGeneric     #-}
{-# LANGUAGE DeriveTraversable #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE LambdaCase        #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ViewPatterns      #-}

module Clash.Primitives.Types
  ( TemplateSource(..)
  , TemplateKind(..)
  , TemplateFormat(..)
  , BlackBoxFunctionName(..)
  , Primitive(..)
  , 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 (..))
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)

-- | 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, Int -> BlackBoxFunctionName -> Int
BlackBoxFunctionName -> Int
(Int -> BlackBoxFunctionName -> Int)
-> (BlackBoxFunctionName -> Int) -> Hashable BlackBoxFunctionName
forall a. (Int -> a -> Int) -> (a -> Int) -> Hashable a
hash :: BlackBoxFunctionName -> Int
$chash :: BlackBoxFunctionName -> Int
hashWithSalt :: Int -> BlackBoxFunctionName -> Int
$chashWithSalt :: Int -> BlackBoxFunctionName -> Int
Hashable)

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

-- | 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 bbfn :: String
bbfn =
  case String -> String -> [String]
splitOn "." 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
$ "Empty function name: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
bbfn
    [_] -> 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
$ "No module or function defined: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
bbfn
    nms :: [String]
nms ->
      let (mods :: [String]
mods, func :: 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 -> 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
$ "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 -> ShowS
forall a. [a] -> [a] -> [a]
++ [String] -> String
forall a. [a] -> a
head [String]
errs
  where
    checkMod :: String -> Either String String
checkMod mod' :: 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
$ "Module name cannot start with lowercase: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
mod'
      | (Char -> Bool) -> String -> Bool
forall (t :: * -> *) 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
$ "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 func :: 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
$ "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, (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, Int -> TemplateFormat -> Int
TemplateFormat -> Int
(Int -> TemplateFormat -> Int)
-> (TemplateFormat -> Int) -> Hashable TemplateFormat
forall a. (Int -> a -> Int) -> (a -> Int) -> Hashable a
hash :: TemplateFormat -> Int
$chash :: TemplateFormat -> Int
hashWithSalt :: Int -> TemplateFormat -> Int
$chashWithSalt :: Int -> TemplateFormat -> Int
Hashable, TemplateFormat -> ()
(TemplateFormat -> ()) -> NFData TemplateFormat
forall a. (a -> ()) -> NFData a
rnf :: TemplateFormat -> ()
$crnf :: TemplateFormat -> ()
NFData)

-- | 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 -> 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 /.json/ 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 -> [((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 /.json/ file
  , 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 -> 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, Int -> Primitive a b c d -> Int
Primitive a b c d -> Int
(Int -> Primitive a b c d -> Int)
-> (Primitive a b c d -> Int) -> Hashable (Primitive a b c d)
forall a. (Int -> a -> Int) -> (a -> Int) -> Hashable a
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
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 :: * -> *).
(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 v :: Object
v) =
    case Object -> [(Text, Value)]
forall k v. HashMap k v -> [(k, v)]
H.toList Object
v of
      [(conKey :: Text
conKey,Object conVal :: Object
conVal)] ->
        case Text
conKey of
          "BlackBoxHaskell"  -> do
            Text
name' <- Object
conVal Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: "name"
            WorkInfo
wf    <- ((Object
conVal Object -> Text -> Parser (Maybe Value)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? "workInfo" Parser (Maybe Value)
-> (Maybe Value -> Parser (Maybe WorkInfo))
-> Parser (Maybe WorkInfo)
forall (m :: * -> *) 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 :: * -> *) a. Applicative f => a -> f a
pure Maybe WorkInfo
forall a. Maybe a
Nothing) Value -> Parser (Maybe WorkInfo)
forall (f :: * -> *). 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 -> Text -> Parser String
forall a. FromJSON a => Object -> Text -> Parser a
.: "templateFunction"
            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 :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
conVal Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: "template")
                 Parser (Maybe TemplateSource)
-> Parser (Maybe TemplateSource) -> Parser (Maybe TemplateSource)
forall (f :: * -> *) 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 :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
conVal Object -> Text -> Parser String
forall a. FromJSON a => Object -> Text -> Parser a
.: "file")
                 Parser (Maybe TemplateSource)
-> Parser (Maybe TemplateSource) -> Parser (Maybe TemplateSource)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Maybe TemplateSource -> Parser (Maybe TemplateSource)
forall (f :: * -> *) 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 :: * -> *) a. MonadFail m => String -> m a
fail BlackBoxFunctionName -> Parser BlackBoxFunctionName
forall (m :: * -> *) a. Monad m => a -> m a
return (HasCallStack => String -> Either String BlackBoxFunctionName
String -> Either String BlackBoxFunctionName
parseBBFN String
fName)
            UnresolvedPrimitive -> Parser UnresolvedPrimitive
forall (m :: * -> *) a. Monad m => a -> m a
return (Text
-> WorkInfo
-> BlackBoxFunctionName
-> Maybe TemplateSource
-> UnresolvedPrimitive
forall a b c d.
Text -> WorkInfo -> BlackBoxFunctionName -> d -> Primitive a b c d
BlackBoxHaskell Text
name' WorkInfo
wf BlackBoxFunctionName
fName' Maybe TemplateSource
templ)
          "BlackBox"  ->
            Text
-> WorkInfo
-> TemplateKind
-> Maybe Text
-> Bool
-> [Text]
-> [Text]
-> [((Text, Text),
     ((TemplateFormat, BlackBoxFunctionName), Maybe TemplateSource))]
-> ((TemplateFormat, BlackBoxFunctionName), Maybe TemplateSource)
-> UnresolvedPrimitive
forall a b c d.
Text
-> WorkInfo
-> TemplateKind
-> c
-> Bool
-> [a]
-> [a]
-> [((Text, Text), b)]
-> b
-> Primitive a b c d
BlackBox (Text
 -> WorkInfo
 -> TemplateKind
 -> Maybe Text
 -> Bool
 -> [Text]
 -> [Text]
 -> [((Text, Text),
      ((TemplateFormat, BlackBoxFunctionName), Maybe TemplateSource))]
 -> ((TemplateFormat, BlackBoxFunctionName), Maybe TemplateSource)
 -> UnresolvedPrimitive)
-> Parser Text
-> Parser
     (WorkInfo
      -> TemplateKind
      -> Maybe Text
      -> Bool
      -> [Text]
      -> [Text]
      -> [((Text, Text),
           ((TemplateFormat, BlackBoxFunctionName), Maybe TemplateSource))]
      -> ((TemplateFormat, BlackBoxFunctionName), Maybe TemplateSource)
      -> UnresolvedPrimitive)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
conVal Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: "name"
                     Parser
  (WorkInfo
   -> TemplateKind
   -> Maybe Text
   -> Bool
   -> [Text]
   -> [Text]
   -> [((Text, Text),
        ((TemplateFormat, BlackBoxFunctionName), Maybe TemplateSource))]
   -> ((TemplateFormat, BlackBoxFunctionName), Maybe TemplateSource)
   -> UnresolvedPrimitive)
-> Parser WorkInfo
-> Parser
     (TemplateKind
      -> Maybe Text
      -> Bool
      -> [Text]
      -> [Text]
      -> [((Text, Text),
           ((TemplateFormat, BlackBoxFunctionName), Maybe TemplateSource))]
      -> ((TemplateFormat, BlackBoxFunctionName), Maybe TemplateSource)
      -> UnresolvedPrimitive)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
conVal Object -> Text -> Parser (Maybe Value)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? "workInfo" Parser (Maybe Value)
-> (Maybe Value -> Parser (Maybe WorkInfo))
-> Parser (Maybe WorkInfo)
forall (m :: * -> *) 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 :: * -> *) a. Applicative f => a -> f a
pure Maybe WorkInfo
forall a. Maybe a
Nothing) Value -> Parser (Maybe WorkInfo)
forall (f :: * -> *). MonadFail f => Value -> f (Maybe WorkInfo)
parseWorkInfo) Parser (Maybe WorkInfo) -> WorkInfo -> Parser WorkInfo
forall a. Parser (Maybe a) -> a -> Parser a
.!= WorkInfo
WorkVariable
                     Parser
  (TemplateKind
   -> Maybe Text
   -> Bool
   -> [Text]
   -> [Text]
   -> [((Text, Text),
        ((TemplateFormat, BlackBoxFunctionName), Maybe TemplateSource))]
   -> ((TemplateFormat, BlackBoxFunctionName), Maybe TemplateSource)
   -> UnresolvedPrimitive)
-> Parser TemplateKind
-> Parser
     (Maybe Text
      -> Bool
      -> [Text]
      -> [Text]
      -> [((Text, Text),
           ((TemplateFormat, BlackBoxFunctionName), Maybe TemplateSource))]
      -> ((TemplateFormat, BlackBoxFunctionName), Maybe TemplateSource)
      -> UnresolvedPrimitive)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
conVal Object -> Text -> Parser Value
forall a. FromJSON a => Object -> Text -> Parser a
.: "kind" Parser Value
-> (Value -> Parser TemplateKind) -> Parser TemplateKind
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Value -> Parser TemplateKind
forall (f :: * -> *). MonadFail f => Value -> f TemplateKind
parseTemplateKind)
                     Parser
  (Maybe Text
   -> Bool
   -> [Text]
   -> [Text]
   -> [((Text, Text),
        ((TemplateFormat, BlackBoxFunctionName), Maybe TemplateSource))]
   -> ((TemplateFormat, BlackBoxFunctionName), Maybe TemplateSource)
   -> UnresolvedPrimitive)
-> Parser (Maybe Text)
-> Parser
     (Bool
      -> [Text]
      -> [Text]
      -> [((Text, Text),
           ((TemplateFormat, BlackBoxFunctionName), Maybe TemplateSource))]
      -> ((TemplateFormat, BlackBoxFunctionName), Maybe TemplateSource)
      -> UnresolvedPrimitive)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
conVal Object -> Text -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? "warning"
                     Parser
  (Bool
   -> [Text]
   -> [Text]
   -> [((Text, Text),
        ((TemplateFormat, BlackBoxFunctionName), Maybe TemplateSource))]
   -> ((TemplateFormat, BlackBoxFunctionName), Maybe TemplateSource)
   -> UnresolvedPrimitive)
-> Parser Bool
-> Parser
     ([Text]
      -> [Text]
      -> [((Text, Text),
           ((TemplateFormat, BlackBoxFunctionName), Maybe TemplateSource))]
      -> ((TemplateFormat, BlackBoxFunctionName), Maybe TemplateSource)
      -> UnresolvedPrimitive)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
conVal Object -> Text -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? "outputReg" Parser (Maybe Bool) -> Bool -> Parser Bool
forall a. Parser (Maybe a) -> a -> Parser a
.!= Bool
False
                     Parser
  ([Text]
   -> [Text]
   -> [((Text, Text),
        ((TemplateFormat, BlackBoxFunctionName), Maybe TemplateSource))]
   -> ((TemplateFormat, BlackBoxFunctionName), Maybe TemplateSource)
   -> UnresolvedPrimitive)
-> Parser [Text]
-> Parser
     ([Text]
      -> [((Text, Text),
           ((TemplateFormat, BlackBoxFunctionName), Maybe TemplateSource))]
      -> ((TemplateFormat, BlackBoxFunctionName), Maybe TemplateSource)
      -> UnresolvedPrimitive)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
conVal Object -> Text -> Parser (Maybe [Text])
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? "libraries" Parser (Maybe [Text]) -> [Text] -> Parser [Text]
forall a. Parser (Maybe a) -> a -> Parser a
.!= []
                     Parser
  ([Text]
   -> [((Text, Text),
        ((TemplateFormat, BlackBoxFunctionName), Maybe TemplateSource))]
   -> ((TemplateFormat, BlackBoxFunctionName), Maybe TemplateSource)
   -> UnresolvedPrimitive)
-> Parser [Text]
-> Parser
     ([((Text, Text),
        ((TemplateFormat, BlackBoxFunctionName), Maybe TemplateSource))]
      -> ((TemplateFormat, BlackBoxFunctionName), Maybe TemplateSource)
      -> UnresolvedPrimitive)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
conVal Object -> Text -> Parser (Maybe [Text])
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? "imports" Parser (Maybe [Text]) -> [Text] -> Parser [Text]
forall a. Parser (Maybe a) -> a -> Parser a
.!= []
                     Parser
  ([((Text, Text),
     ((TemplateFormat, BlackBoxFunctionName), Maybe TemplateSource))]
   -> ((TemplateFormat, BlackBoxFunctionName), Maybe TemplateSource)
   -> UnresolvedPrimitive)
-> Parser
     [((Text, Text),
       ((TemplateFormat, BlackBoxFunctionName), Maybe TemplateSource))]
-> Parser
     (((TemplateFormat, BlackBoxFunctionName), Maybe TemplateSource)
      -> UnresolvedPrimitive)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
conVal Object -> Text -> Parser (Maybe [Object])
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? "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 :: * -> *) 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 :: * -> *) (f :: * -> *) 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)
   -> UnresolvedPrimitive)
-> Parser
     ((TemplateFormat, BlackBoxFunctionName), Maybe TemplateSource)
-> Parser UnresolvedPrimitive
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
-> Parser
     ((TemplateFormat, BlackBoxFunctionName), Maybe TemplateSource)
parseTemplate Object
conVal
          "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 :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
conVal Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: "name"
                      Parser (WorkInfo -> Text -> UnresolvedPrimitive)
-> Parser WorkInfo -> Parser (Text -> UnresolvedPrimitive)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
conVal Object -> Text -> Parser (Maybe Value)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? "workInfo" Parser (Maybe Value)
-> (Maybe Value -> Parser (Maybe WorkInfo))
-> Parser (Maybe WorkInfo)
forall (m :: * -> *) 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 :: * -> *) a. Applicative f => a -> f a
pure Maybe WorkInfo
forall a. Maybe a
Nothing) Value -> Parser (Maybe WorkInfo)
forall (f :: * -> *). 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 :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
conVal Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: "primType"

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

      parseInclude :: Object
-> Parser
     ((a, a),
      ((TemplateFormat, BlackBoxFunctionName), Maybe TemplateSource))
parseInclude c :: 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 :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((,) (a -> a -> (a, a)) -> Parser a -> Parser (a -> (a, a))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
c Object -> Text -> Parser a
forall a. FromJSON a => Object -> Text -> Parser a
.: "name" Parser (a -> (a, a)) -> Parser a -> Parser (a, a)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
c Object -> Text -> Parser a
forall a. FromJSON a => Object -> Text -> Parser a
.: "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 :: * -> *) 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 "Declaration") = TemplateKind -> f TemplateKind
forall (f :: * -> *) a. Applicative f => a -> f a
pure TemplateKind
TDecl
      parseTemplateKind (String "Expression")  = TemplateKind -> f TemplateKind
forall (f :: * -> *) a. Applicative f => a -> f a
pure TemplateKind
TExpr
      parseTemplateKind c :: Value
c = String -> f TemplateKind
forall (m :: * -> *) a. MonadFail m => String -> m a
fail ("[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 "Template") = TemplateFormat -> f TemplateFormat
forall (f :: * -> *) a. Applicative f => a -> f a
pure TemplateFormat
TTemplate
      parseTemplateFormat (String "Haskell")  = TemplateFormat -> f TemplateFormat
forall (f :: * -> *) a. Applicative f => a -> f a
pure TemplateFormat
THaskell
      parseTemplateFormat c :: Value
c = String -> f TemplateFormat
forall (m :: * -> *) a. MonadFail m => String -> m a
fail ("[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 "Constant") = Maybe WorkInfo -> f (Maybe WorkInfo)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (WorkInfo -> Maybe WorkInfo
forall a. a -> Maybe a
Just WorkInfo
WorkConstant)
      parseWorkInfo (String "Never")    = Maybe WorkInfo -> f (Maybe WorkInfo)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (WorkInfo -> Maybe WorkInfo
forall a. a -> Maybe a
Just WorkInfo
WorkNever)
      parseWorkInfo (String "Variable") = Maybe WorkInfo -> f (Maybe WorkInfo)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (WorkInfo -> Maybe WorkInfo
forall a. a -> Maybe a
Just WorkInfo
WorkVariable)
      parseWorkInfo (String "Always")   = Maybe WorkInfo -> f (Maybe WorkInfo)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (WorkInfo -> Maybe WorkInfo
forall a. a -> Maybe a
Just WorkInfo
WorkAlways)
      parseWorkInfo c :: Value
c = String -> f (Maybe WorkInfo)
forall (m :: * -> *) a. MonadFail m => String -> m a
fail ("[6] unexpected workInfo: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Value -> String
forall a. Show a => a -> String
show Value
c)

      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 :: * -> *) a. MonadFail m => String -> m a
fail BlackBoxFunctionName -> Parser BlackBoxFunctionName
forall (m :: * -> *) 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 ["Template"] "template"

  parseJSON unexpected :: Value
unexpected =
    String -> Parser UnresolvedPrimitive
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser UnresolvedPrimitive)
-> String -> Parser UnresolvedPrimitive
forall a b. (a -> b) -> a -> b
$ "[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