-- | Defines functions used in the Requirements section.
module Drasil.Sections.Requirements (
  -- * Requirements
  reqF, reqInputsRef,
  -- * Functional Requirements
  fReqF,
  -- ** Input Requirements
  fullReqs, fullTables, inReq, inTable,
  mkInputPropsTable, mkQRTuple, mkQRTupleRef, mkValsSourceTable,
  -- * Non-functional Requirements
  nfReqF, mkMaintainableNFR, mkPortableNFR, mkCorrectNFR, mkVerifiableNFR, 
  mkUnderstandableNFR, mkReusableNFR, mkSecurityNFR
  ) where

import Utils.Drasil (stringList)

import Language.Drasil
import Language.Drasil.Chunk.Concept.NamedCombinators
import qualified Language.Drasil.Sentence.Combinators as S
import Drasil.Sections.ReferenceMaterial(emptySectSentPlu)
import Theory.Drasil (HasOutput(output))

import Data.Drasil.Concepts.Documentation (description, funcReqDom, nonFuncReqDom,
  functionalRequirement, input_, nonfunctionalRequirement, output_, section_,
  software, symbol_, value, reqInput, code, propOfCorSol, vavPlan, mg, mis)
import Data.Drasil.Concepts.Math (unit_)

import qualified Drasil.DocLang.SRS as SRS
import Drasil.DocumentLanguage.Units (toSentence)
import Data.List (nub)

import Control.Lens ((^.))
import Data.Bifunctor (bimap)


-- | Wrapper for 'reqIntro'.
reqF :: [Section] -> Section
reqF :: [Section] -> Section
reqF = [Contents] -> [Section] -> Section
SRS.require [Contents
reqIntro]

-- | Prepends a 'ConceptInstance' referencing an input-value table to a list of other 'ConceptInstance's.
-- For listing input requirements.
fullReqs :: (Quantity i, MayHaveUnit i) => [i] -> Sentence -> [ConceptInstance] -> [ConceptInstance]
fullReqs :: forall i.
(Quantity i, MayHaveUnit i) =>
[i] -> Sentence -> [ConceptInstance] -> [ConceptInstance]
fullReqs [] Sentence
_ [ConceptInstance]
_ = []
fullReqs [i]
i Sentence
d [ConceptInstance]
r = [ConceptInstance] -> [ConceptInstance]
forall a. Eq a => [a] -> [a]
nub ([ConceptInstance] -> [ConceptInstance])
-> [ConceptInstance] -> [ConceptInstance]
forall a b. (a -> b) -> a -> b
$ Sentence -> ConceptInstance
inReq (LabelledContent -> Sentence -> Sentence
forall r.
(HasShortName r, Referable r) =>
r -> Sentence -> Sentence
inReqDesc ([i] -> LabelledContent
forall i. (Quantity i, MayHaveUnit i) => [i] -> LabelledContent
inTable [i]
i) Sentence
d) ConceptInstance -> [ConceptInstance] -> [ConceptInstance]
forall a. a -> [a] -> [a]
: [ConceptInstance]
r-- ++ [outReq (outReqDesc outTable)]

-- | Prepends given LabelledContent to an input-value table.
fullTables :: (Quantity i, MayHaveUnit i) => [i] -> [LabelledContent] -> [LabelledContent]
fullTables :: forall i.
(Quantity i, MayHaveUnit i) =>
[i] -> [LabelledContent] -> [LabelledContent]
fullTables [] [LabelledContent]
_ = []
fullTables [i]
i [LabelledContent]
t = [i] -> LabelledContent
forall i. (Quantity i, MayHaveUnit i) => [i] -> LabelledContent
inTable [i]
i LabelledContent -> [LabelledContent] -> [LabelledContent]
forall a. a -> [a] -> [a]
: [LabelledContent]
t

-- | Creates a generalized input-value table for the Requirements section.
inTable :: (Quantity i, MayHaveUnit i) => [i] -> LabelledContent
inTable :: forall i. (Quantity i, MayHaveUnit i) => [i] -> LabelledContent
inTable [i]
i = [i] -> ConceptInstance -> LabelledContent
forall i r.
(Quantity i, MayHaveUnit i, HasShortName r, Referable r) =>
[i] -> r -> LabelledContent
mkInputPropsTable [i]
i (Sentence -> ConceptInstance
inReq Sentence
EmptyS) -- passes empty Sentence to make stub of inReq
--outTable    = mkValsSourceTable o "ReqOutputs" (S "Required" +:+ titleize' output_ `follows` (outReq EmptyS))
                                                -- passes empty Sentence to make stub of outReq

-- | Creates a Sentence from a Referable and possible description. Output is of the form
-- "Inputs the values from @reference@, which define @description@". If no description is given,
-- there will be nothing after the word "@reference@".
inReqDesc :: (HasShortName r, Referable r) => r -> Sentence -> Sentence 
inReqDesc :: forall r.
(HasShortName r, Referable r) =>
r -> Sentence -> Sentence
inReqDesc  r
t Sentence
desc = [Sentence] -> Sentence
foldlSent [IdeaDict -> Sentence
forall n. NamedIdea n => n -> Sentence
atStart IdeaDict
input_,  String -> Sentence
S String
"the", IdeaDict -> Sentence
forall n. NamedIdea n => n -> Sentence
plural IdeaDict
value, String -> Sentence
S String
"from", Sentence
end]
  where end :: Sentence
end = case Sentence
desc of Sentence
EmptyS -> r -> Sentence
forall r.
(HasUID r, HasRefAddress r, HasShortName r) =>
r -> Sentence
refS r
t
                           Sentence
sent   -> r -> Sentence
forall r.
(HasUID r, HasRefAddress r, HasShortName r) =>
r -> Sentence
refS r
t Sentence -> Sentence -> Sentence
`sC` String -> Sentence
S String
"which define" Sentence -> Sentence -> Sentence
+:+ Sentence
sent
--outReqDesc t = foldlSent [atStart output_, S "the", plural value, S "from", refS t]

-- | Creates a 'ConceptInstance' of input values.
inReq :: Sentence -> ConceptInstance
inReq :: Sentence -> ConceptInstance
inReq  Sentence
s = String -> Sentence -> String -> ConceptChunk -> ConceptInstance
forall c.
Concept c =>
String -> Sentence -> String -> c -> ConceptInstance
cic String
"inputValues"  Sentence
s String
"Input-Values"  ConceptChunk
funcReqDom
--outReq s = cic "inputValues" s "Output-Values" funcReqDom

-- | Adds a generalized introduction for a Non-Fucntional Requirements section. Takes in the contents of that section.
fReqF :: [Contents] -> Section
fReqF :: [Contents] -> Section
fReqF [Contents]
listOfFReqs = [Contents] -> [Section] -> Section
SRS.funcReq ([Contents] -> Contents
fReqIntro [Contents]
listOfFReqs Contents -> [Contents] -> [Contents]
forall a. a -> [a] -> [a]
: [Contents]
listOfFReqs) []

-- | Adds a generalized introduction for a Non-Fucntional Requirements section. Takes in the contents of that section.
nfReqF :: [Contents] -> Section
nfReqF :: [Contents] -> Section
nfReqF [Contents]
nfrs = [Contents] -> [Section] -> Section
SRS.nonfuncReq ([Contents] -> Contents
nfReqIntro [Contents]
nfrs Contents -> [Contents] -> [Contents]
forall a. a -> [a] -> [a]
: [Contents]
nfrs) []

-- | General 'Sentence' for use in the Requirements section introduction.
reqIntroStart :: Sentence
reqIntroStart :: Sentence
reqIntroStart = [Sentence] -> Sentence
foldlSent_ [String -> Sentence
S String
"This", IdeaDict -> Sentence
forall n. NamedIdea n => n -> Sentence
phrase IdeaDict
section_, String -> Sentence
S String
"provides"]

-- | General 'Sentence' for use in the Functional Requirements subsection introduction.
frReqIntroBody :: Sentence
frReqIntroBody :: Sentence
frReqIntroBody = [Sentence] -> Sentence
foldlSent_ [NP -> Sentence
forall n. NounPhrase n => n -> Sentence
pluralNP (IdeaDict -> NP
forall t. NamedIdea t => t -> NP
the IdeaDict
functionalRequirement) Sentence -> Sentence -> Sentence
`sC`
  String -> Sentence
S String
"the tasks and behaviours that the", IdeaDict -> Sentence
forall n. NamedIdea n => n -> Sentence
phrase IdeaDict
software, String -> Sentence
S String
"is expected to complete"]

-- | General 'Sentence' for use in the Non-Functional Requirements subsection introduction.
nfrReqIntroBody :: Sentence
nfrReqIntroBody :: Sentence
nfrReqIntroBody = [Sentence] -> Sentence
foldlSent_ [NP -> Sentence
forall n. NounPhrase n => n -> Sentence
pluralNP (IdeaDict -> NP
forall t. NamedIdea t => t -> NP
the IdeaDict
nonfunctionalRequirement) Sentence -> Sentence -> Sentence
`sC`
  String -> Sentence
S String
"the qualities that the", IdeaDict -> Sentence
forall n. NamedIdea n => n -> Sentence
phrase IdeaDict
software, String -> Sentence
S String
"is expected to exhibit"]

-- | Generalized Requirements section introduction.
reqIntro :: Contents
reqIntro :: Contents
reqIntro = Sentence -> Contents
mkParagraph (Sentence -> Contents) -> Sentence -> Contents
forall a b. (a -> b) -> a -> b
$ Sentence
reqIntroStart Sentence -> Sentence -> Sentence
+:+. (Sentence
frReqIntroBody Sentence -> Sentence -> Sentence
`sC` Sentence
EmptyS Sentence -> Sentence -> Sentence
`S.and_` Sentence
nfrReqIntroBody)

-- | Generalized Functional Requirements subsection introduction.
fReqIntro :: [Contents] -> Contents
fReqIntro :: [Contents] -> Contents
fReqIntro [] = Sentence -> Contents
mkParagraph (Sentence -> Contents) -> Sentence -> Contents
forall a b. (a -> b) -> a -> b
$ [IdeaDict] -> Sentence
forall n. NamedIdea n => [n] -> Sentence
emptySectSentPlu [IdeaDict
functionalRequirement]
fReqIntro [Contents]
_  = Sentence -> Contents
mkParagraph (Sentence -> Contents) -> Sentence -> Contents
forall a b. (a -> b) -> a -> b
$ Sentence
reqIntroStart Sentence -> Sentence -> Sentence
+:+. Sentence
frReqIntroBody

-- | Generalized Non-Functional Requirements subsection introduction.
nfReqIntro :: [Contents] -> Contents
nfReqIntro :: [Contents] -> Contents
nfReqIntro [] = Sentence -> Contents
mkParagraph (Sentence -> Contents) -> Sentence -> Contents
forall a b. (a -> b) -> a -> b
$ [IdeaDict] -> Sentence
forall n. NamedIdea n => [n] -> Sentence
emptySectSentPlu [IdeaDict
nonfunctionalRequirement]
nfReqIntro [Contents]
_  = Sentence -> Contents
mkParagraph (Sentence -> Contents) -> Sentence -> Contents
forall a b. (a -> b) -> a -> b
$ Sentence
reqIntroStart Sentence -> Sentence -> Sentence
+:+. Sentence
nfrReqIntroBody

-- | Common Non-Functional Requirement for Maintainability.
-- Takes in a Reference Address ('String'), a percent value ('Integer'), 
-- and a label ('String').
mkMaintainableNFR :: String -> Integer -> String -> ConceptInstance
mkMaintainableNFR :: String -> Integer -> String -> ConceptInstance
mkMaintainableNFR String
refAddress Integer
percent String
lbl = String -> Sentence -> String -> ConceptChunk -> ConceptInstance
forall c.
Concept c =>
String -> Sentence -> String -> c -> ConceptInstance
cic String
refAddress ([Sentence] -> Sentence
foldlSent [
  String -> Sentence
S String
"If a likely change is made" Sentence -> Sentence -> Sentence
`S.toThe` 
  String -> Sentence
S String
"finished software, it will take at most", Integer -> Sentence
forall a. Show a => a -> Sentence
addPercent Integer
percent Sentence -> Sentence -> Sentence
`S.ofThe`
  String -> Sentence
S String
"original development time,",
  String -> Sentence
S String
"assuming the same development resources are available"
  ]) String
lbl ConceptChunk
nonFuncReqDom

-- | Common Non-Functional Requirement for Portability.
mkPortableNFR :: String -> [String] -> String -> ConceptInstance
mkPortableNFR :: String -> [String] -> String -> ConceptInstance
mkPortableNFR String
_ [] String
_ = String -> ConceptInstance
forall a. HasCallStack => String -> a
error String
"No operating systems specified; cannot create a requirement."
mkPortableNFR String
refAddress [String
os] String
lbl = String -> Sentence -> String -> ConceptChunk -> ConceptInstance
forall c.
Concept c =>
String -> Sentence -> String -> c -> ConceptInstance
cic String
refAddress (String -> Sentence
S (String -> Sentence) -> String -> Sentence
forall a b. (a -> b) -> a -> b
$ String
"The code shall be portable to " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
os) String
lbl ConceptChunk
nonFuncReqDom
mkPortableNFR String
refAddress [String]
osList String
lbl = String -> Sentence -> String -> ConceptChunk -> ConceptInstance
forall c.
Concept c =>
String -> Sentence -> String -> c -> ConceptInstance
cic String
refAddress ([Sentence] -> Sentence
foldlSent [
  String -> Sentence
S String
"The code shall be portable to multiple environments, particularly",
  String -> Sentence
S (String -> Sentence) -> String -> Sentence
forall a b. (a -> b) -> a -> b
$ [String] -> String
stringList [String]
osList
  ]) String
lbl ConceptChunk
nonFuncReqDom

-- | Common Non-Functional Requirement for Correctness.
mkCorrectNFR :: String -> String -> ConceptInstance
mkCorrectNFR :: String -> String -> ConceptInstance
mkCorrectNFR String
refAddress String
lbl = String -> Sentence -> String -> ConceptChunk -> ConceptInstance
forall c.
Concept c =>
String -> Sentence -> String -> c -> ConceptInstance
cic String
refAddress ([Sentence] -> Sentence
foldlSent [
  NP -> Sentence
forall n. NounPhrase n => n -> Sentence
atStartNP' (IdeaDict
output_ IdeaDict -> IdeaDict -> NP
forall c d. (NamedIdea c, NamedIdea d) => c -> d -> NP
`the_ofThePS` IdeaDict
code), String -> Sentence
S String
"have the",
  Section -> Sentence -> Sentence
forall r.
(HasUID r, HasRefAddress r, HasShortName r) =>
r -> Sentence -> Sentence
namedRef ([Contents] -> [Section] -> Section
SRS.propCorSol [] []) (IdeaDict -> Sentence
forall n. NamedIdea n => n -> Sentence
plural IdeaDict
propOfCorSol)
  ]) String
lbl ConceptChunk
nonFuncReqDom

-- | Common Non-Functional Requirement for Verifiability.
mkVerifiableNFR :: String -> String -> ConceptInstance
mkVerifiableNFR :: String -> String -> ConceptInstance
mkVerifiableNFR String
refAddress String
lbl = String -> Sentence -> String -> ConceptChunk -> ConceptInstance
forall c.
Concept c =>
String -> Sentence -> String -> c -> ConceptInstance
cic String
refAddress ([Sentence] -> Sentence
foldlSent [
  NP -> Sentence
forall n. NounPhrase n => n -> Sentence
atStartNP (IdeaDict -> NP
forall t. NamedIdea t => t -> NP
the IdeaDict
code), String -> Sentence
S String
"is tested with complete",
  IdeaDict -> Sentence
forall n. NamedIdea n => n -> Sentence
phrase IdeaDict
vavPlan]) String
lbl ConceptChunk
nonFuncReqDom

-- | Common Non-Functional Requirement for Understandability.
mkUnderstandableNFR :: String -> String -> ConceptInstance
mkUnderstandableNFR :: String -> String -> ConceptInstance
mkUnderstandableNFR String
refAddress String
lbl = String -> Sentence -> String -> ConceptChunk -> ConceptInstance
forall c.
Concept c =>
String -> Sentence -> String -> c -> ConceptInstance
cic String
refAddress ([Sentence] -> Sentence
foldlSent [
  NP -> Sentence
forall n. NounPhrase n => n -> Sentence
atStartNP (IdeaDict -> NP
forall t. NamedIdea t => t -> NP
the IdeaDict
code), String -> Sentence
S String
"is modularized with complete",
  CI -> Sentence
forall n. NamedIdea n => n -> Sentence
phrase CI
mg Sentence -> Sentence -> Sentence
`S.and_` CI -> Sentence
forall n. NamedIdea n => n -> Sentence
phrase CI
mis]) String
lbl ConceptChunk
nonFuncReqDom

-- | Common Non-Functional Requirement for Reusability.
mkReusableNFR :: String -> String -> ConceptInstance
mkReusableNFR :: String -> String -> ConceptInstance
mkReusableNFR String
refAddress String
lbl = String -> Sentence -> String -> ConceptChunk -> ConceptInstance
forall c.
Concept c =>
String -> Sentence -> String -> c -> ConceptInstance
cic String
refAddress ([Sentence] -> Sentence
foldlSent [
  NP -> Sentence
forall n. NounPhrase n => n -> Sentence
atStartNP (IdeaDict -> NP
forall t. NamedIdea t => t -> NP
the IdeaDict
code), String -> Sentence
S String
"is modularized"]) String
lbl ConceptChunk
nonFuncReqDom

-- | Common Non-Functional Requirement for Security.
mkSecurityNFR :: String -> String -> ConceptInstance
mkSecurityNFR :: String -> String -> ConceptInstance
mkSecurityNFR String
refAddress String
lbl = String -> Sentence -> String -> ConceptChunk -> ConceptInstance
forall c.
Concept c =>
String -> Sentence -> String -> c -> ConceptInstance
cic String
refAddress ([Sentence] -> Sentence
foldlSent [
  String -> Sentence
S String
"The code shall be immune to common security problems such as memory",
  String -> Sentence
S String
"leaks, divide by zero errors, and the square root of negative numbers"
  ]) String
lbl ConceptChunk
nonFuncReqDom

-- | Creates an Input Data Table for use in the Functional Requirments section. Takes a list of wrapped variables and something that is 'Referable'.
mkInputPropsTable :: (Quantity i, MayHaveUnit i, HasShortName r, Referable r) => 
                          [i] -> r -> LabelledContent
mkInputPropsTable :: forall i r.
(Quantity i, MayHaveUnit i, HasShortName r, Referable r) =>
[i] -> r -> LabelledContent
mkInputPropsTable []        r
_   = Reference -> RawContent -> LabelledContent
llcc Reference
reqInputsRef (RawContent -> LabelledContent) -> RawContent -> LabelledContent
forall a b. (a -> b) -> a -> b
$ Sentence -> RawContent
Paragraph Sentence
EmptyS
mkInputPropsTable [i]
reqInputs r
req = Reference -> RawContent -> LabelledContent
llcc Reference
reqInputsRef (RawContent -> LabelledContent) -> RawContent -> LabelledContent
forall a b. (a -> b) -> a -> b
$ 
  [Sentence] -> [[Sentence]] -> Sentence -> Bool -> RawContent
Table [IdeaDict -> Sentence
forall n. NamedIdea n => n -> Sentence
atStart IdeaDict
symbol_, IdeaDict -> Sentence
forall n. NamedIdea n => n -> Sentence
atStart IdeaDict
description, ConceptChunk -> Sentence
forall n. NamedIdea n => n -> Sentence
atStart' ConceptChunk
unit_]
  ([i -> Sentence] -> [i] -> [[Sentence]]
forall a b. [a -> b] -> [a] -> [[b]]
mkTable [i -> Sentence
forall c. (HasUID c, HasSymbol c) => c -> Sentence
ch, i -> Sentence
forall n. NamedIdea n => n -> Sentence
atStart, i -> Sentence
forall u. MayHaveUnit u => u -> Sentence
toSentence] ([i] -> [[Sentence]]) -> [i] -> [[Sentence]]
forall a b. (a -> b) -> a -> b
$ [i] -> [i]
forall a. HasSymbol a => [a] -> [a]
sortBySymbol [i]
reqInputs)
  (IdeaDict -> Sentence
forall n. NamedIdea n => n -> Sentence
titleize' IdeaDict
reqInput Sentence -> r -> Sentence
forall r.
(Referable r, HasShortName r) =>
Sentence -> r -> Sentence
`follows` r
req) Bool
True

-- | Reference for the Required Inputs table.
reqInputsRef :: Reference
reqInputsRef :: Reference
reqInputsRef = UID -> Reference
makeTabRef' (IdeaDict
reqInput IdeaDict -> Getting UID IdeaDict UID -> UID
forall s a. s -> Getting a s a -> a
^. Getting UID IdeaDict UID
forall c. HasUID c => Getter c UID
Getter IdeaDict UID
uid)

-- | Creates a table for use in the Functional Requirments section. Takes a list of tuples containing variables and sources, a label, and a caption. 
mkValsSourceTable :: (Quantity i, MayHaveUnit i) => 
                          [(i, Sentence)] -> String -> Sentence -> LabelledContent
mkValsSourceTable :: forall i.
(Quantity i, MayHaveUnit i) =>
[(i, Sentence)] -> String -> Sentence -> LabelledContent
mkValsSourceTable [(i, Sentence)]
vals String
labl Sentence
cap = Reference -> RawContent -> LabelledContent
llcc (String -> Reference
makeTabRef String
labl) (RawContent -> LabelledContent) -> RawContent -> LabelledContent
forall a b. (a -> b) -> a -> b
$ 
  [Sentence] -> [[Sentence]] -> Sentence -> Bool -> RawContent
Table [IdeaDict -> Sentence
forall n. NamedIdea n => n -> Sentence
atStart IdeaDict
symbol_, IdeaDict -> Sentence
forall n. NamedIdea n => n -> Sentence
atStart IdeaDict
description, String -> Sentence
S String
"Source", ConceptChunk -> Sentence
forall n. NamedIdea n => n -> Sentence
atStart' ConceptChunk
unit_]
  ([(i, Sentence) -> Sentence] -> [(i, Sentence)] -> [[Sentence]]
forall a b. [a -> b] -> [a] -> [[b]]
mkTable [i -> Sentence
forall c. (HasUID c, HasSymbol c) => c -> Sentence
ch (i -> Sentence)
-> ((i, Sentence) -> i) -> (i, Sentence) -> Sentence
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (i, Sentence) -> i
forall a b. (a, b) -> a
fst, i -> Sentence
forall n. NamedIdea n => n -> Sentence
atStart (i -> Sentence)
-> ((i, Sentence) -> i) -> (i, Sentence) -> Sentence
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (i, Sentence) -> i
forall a b. (a, b) -> a
fst, (i, Sentence) -> Sentence
forall a b. (a, b) -> b
snd, i -> Sentence
forall u. MayHaveUnit u => u -> Sentence
toSentence (i -> Sentence)
-> ((i, Sentence) -> i) -> (i, Sentence) -> Sentence
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (i, Sentence) -> i
forall a b. (a, b) -> a
fst] ([(i, Sentence)] -> [[Sentence]])
-> [(i, Sentence)] -> [[Sentence]]
forall a b. (a -> b) -> a -> b
$ [(i, Sentence)] -> [(i, Sentence)]
forall a b. HasSymbol a => [(a, b)] -> [(a, b)]
sortBySymbolTuple [(i, Sentence)]
vals) Sentence
cap Bool
True

mkQRTuple :: (HasOutput i, HasShortName i, Referable i) => [i] -> [(QuantityDict, Sentence)]
mkQRTuple :: forall i.
(HasOutput i, HasShortName i, Referable i) =>
[i] -> [(QuantityDict, Sentence)]
mkQRTuple = (i -> (QuantityDict, Sentence))
-> [i] -> [(QuantityDict, Sentence)]
forall a b. (a -> b) -> [a] -> [b]
map (\i
c -> (i
c i -> Getting QuantityDict i QuantityDict -> QuantityDict
forall s a. s -> Getting a s a -> a
^. Getting QuantityDict i QuantityDict
forall c. HasOutput c => Getter c QuantityDict
Getter i QuantityDict
output, i -> Sentence
forall r.
(HasUID r, HasRefAddress r, HasShortName r) =>
r -> Sentence
refS i
c))

mkQRTupleRef :: (Quantity i, MayHaveUnit i, HasShortName r, Referable r) => [i] -> [r] -> [(QuantityDict, Sentence)]
mkQRTupleRef :: forall i r.
(Quantity i, MayHaveUnit i, HasShortName r, Referable r) =>
[i] -> [r] -> [(QuantityDict, Sentence)]
mkQRTupleRef = (i -> r -> (QuantityDict, Sentence))
-> [i] -> [r] -> [(QuantityDict, Sentence)]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (((i, r) -> (QuantityDict, Sentence))
-> i -> r -> (QuantityDict, Sentence)
forall a b c. ((a, b) -> c) -> a -> b -> c
curry ((i -> QuantityDict)
-> (r -> Sentence) -> (i, r) -> (QuantityDict, Sentence)
forall a b c d. (a -> b) -> (c -> d) -> (a, c) -> (b, d)
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap i -> QuantityDict
forall q. (Quantity q, MayHaveUnit q) => q -> QuantityDict
qw r -> Sentence
forall r.
(HasUID r, HasRefAddress r, HasShortName r) =>
r -> Sentence
refS))