{-# Language PostfixOperators #-}
module Language.Drasil.Document.Combinators (
chgsStart, definedIn, definedIn', definedIn'', definedIn''',
eqnWSource, fromReplace, fromSource, fromSources, fmtU, follows,
makeListRef,
addPercent, displayStrConstrntsAsSet, displayDblConstrntsAsSet,
eqN, checkValidStr, getTandS, maybeChanged, maybeExpanded,
maybeWOVerb, showingCxnBw, substitute, typUncr, underConsidertn,
unwrap, fterms,
bulletFlat, bulletNested, itemRefToSent, makeTMatrix, mkEnumAbbrevList,
mkTableFromColumns, noRefs, refineChain, sortBySymbol, sortBySymbolTuple,
tAndDOnly, tAndDWAcc, tAndDWSym,
zipSentList
) where
import Language.Drasil.Chunk.Concept.Core ( ConceptChunk )
import Language.Drasil.Chunk.UnitDefn ( UnitDefn, MayHaveUnit(..) )
import Language.Drasil.Chunk.Unital ( UnitalChunk )
import Language.Drasil.Classes
( HasUnitSymbol(usymb),
Quantity,
Concept,
Definition(defn),
NamedIdea(..) )
import Language.Drasil.ShortName (HasShortName(..))
import Language.Drasil.Development.Sentence
( short, atStart, titleize, phrase, plural )
import Language.Drasil.Document ( Section )
import Language.Drasil.Document.Core
( ItemType(..), ListType(Bullet) )
import Language.Drasil.Expr.Class ( ExprC(sy) )
import Language.Drasil.ModelExpr.Class ( ModelExprC(isIn) )
import Language.Drasil.ModelExpr.Lang ( ModelExpr )
import Language.Drasil.NounPhrase.Core ( NP )
import Language.Drasil.Reference ( refS, namedRef )
import Language.Drasil.Sentence
( Sentence(S, Percent, (:+:), Sy, EmptyS),
eS,
ch,
sParen,
sDash,
(+:+),
sC,
(+:+.),
(!.),
(+:),
capSent )
import Language.Drasil.Space ( Space(DiscreteD, DiscreteS) )
import Language.Drasil.Symbol.Helpers ( eqSymb )
import Language.Drasil.Uncertainty
import Language.Drasil.Symbol
import Language.Drasil.Sentence.Fold
import qualified Language.Drasil.Sentence.Combinators as S (are, in_, is, toThe)
import Language.Drasil.UID ( HasUID )
import Language.Drasil.Label.Type
import Control.Lens ((^.))
import Data.Decimal (DecimalRaw, realFracToDecimal)
import Data.Function (on)
import Data.List (sortBy, transpose)
sortBySymbol :: HasSymbol a => [a] -> [a]
sortBySymbol :: [a] -> [a]
sortBySymbol = (a -> a -> Ordering) -> [a] -> [a]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy a -> a -> Ordering
forall a. HasSymbol a => a -> a -> Ordering
compareBySymbol
sortBySymbolTuple :: HasSymbol a => [(a, b)] -> [(a, b)]
sortBySymbolTuple :: [(a, b)] -> [(a, b)]
sortBySymbolTuple = ((a, b) -> (a, b) -> Ordering) -> [(a, b)] -> [(a, b)]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (a -> a -> Ordering
forall a. HasSymbol a => a -> a -> Ordering
compareBySymbol (a -> a -> Ordering)
-> ((a, b) -> a) -> (a, b) -> (a, b) -> Ordering
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` (a, b) -> a
forall a b. (a, b) -> a
fst)
compareBySymbol :: HasSymbol a => a -> a -> Ordering
compareBySymbol :: a -> a -> Ordering
compareBySymbol a :: a
a b :: a
b = Symbol -> Symbol -> Ordering
compsy (a -> Symbol
forall q. HasSymbol q => q -> Symbol
eqSymb a
a) (a -> Symbol
forall q. HasSymbol q => q -> Symbol
eqSymb a
b)
eqN :: Int -> Sentence
eqN :: Int -> Sentence
eqN n :: Int
n = String -> Sentence
S "Equation" Sentence -> Sentence -> Sentence
+:+ Sentence -> Sentence
sParen (String -> Sentence
S (String -> Sentence) -> String -> Sentence
forall a b. (a -> b) -> a -> b
$ Int -> String
forall a. Show a => a -> String
show Int
n)
eqnWSource :: (Referable r, HasShortName r) => ModelExpr -> r -> Sentence
eqnWSource :: ModelExpr -> r -> Sentence
eqnWSource a :: ModelExpr
a b :: r
b = ModelExpr -> Sentence
eS ModelExpr
a Sentence -> Sentence -> Sentence
+:+ Sentence -> Sentence
sParen (r -> Sentence
forall r.
(HasUID r, HasRefAddress r, HasShortName r) =>
r -> Sentence
refS r
b)
fromReplace :: (Referable r, HasShortName r) => r -> UnitalChunk -> Sentence
fromReplace :: r -> UnitalChunk -> Sentence
fromReplace src :: r
src c :: UnitalChunk
c = String -> Sentence
S "From" Sentence -> Sentence -> Sentence
+:+ r -> Sentence
forall r.
(HasUID r, HasRefAddress r, HasShortName r) =>
r -> Sentence
refS r
src Sentence -> Sentence -> Sentence
`sC` String -> Sentence
S "we can replace" Sentence -> Sentence -> Sentence
+: UnitalChunk -> Sentence
forall c. (HasUID c, HasSymbol c) => c -> Sentence
ch UnitalChunk
c
substitute :: (Referable r, HasShortName r, HasSymbol r) => [r] -> Sentence
substitute :: [r] -> Sentence
substitute s :: [r]
s = String -> Sentence
S "By substituting" Sentence -> Sentence -> Sentence
+: (SepType -> FoldType -> [Sentence] -> Sentence
foldlList SepType
Comma FoldType
List [Sentence]
l Sentence -> Sentence -> Sentence
`sC` String -> Sentence
S "this can be written as")
where l :: [Sentence]
l = (r -> Sentence) -> [r] -> [Sentence]
forall a b. (a -> b) -> [a] -> [b]
map (\x :: r
x -> r -> Sentence
forall c. (HasUID c, HasSymbol c) => c -> Sentence
ch r
x Sentence -> Sentence -> Sentence
+:+ r -> Sentence
forall r. (Referable r, HasShortName r) => r -> Sentence
fromSource r
x) [r]
s
definedIn :: (Referable r, HasShortName r, HasSymbol r) => r -> Sentence
definedIn :: r -> Sentence
definedIn q :: r
q = r -> Sentence
forall c. (HasUID c, HasSymbol c) => c -> Sentence
ch r
q Sentence -> Sentence -> Sentence
`S.is` String -> Sentence
S "defined in" Sentence -> Sentence -> Sentence
+:+. r -> Sentence
forall r.
(HasUID r, HasRefAddress r, HasShortName r) =>
r -> Sentence
refS r
q
definedIn' :: (Referable r, HasShortName r, HasSymbol r) => r -> Sentence -> Sentence
definedIn' :: r -> Sentence -> Sentence
definedIn' q :: r
q info :: Sentence
info = r -> Sentence
forall c. (HasUID c, HasSymbol c) => c -> Sentence
ch r
q Sentence -> Sentence -> Sentence
`S.is` String -> Sentence
S "defined" Sentence -> Sentence -> Sentence
`S.in_` r -> Sentence
forall r.
(HasUID r, HasRefAddress r, HasShortName r) =>
r -> Sentence
refS r
q Sentence -> Sentence -> Sentence
+:+. Sentence
info
definedIn'' :: (Referable r, HasShortName r) => r -> Sentence
definedIn'' :: r -> Sentence
definedIn'' q :: r
q = String -> Sentence
S "defined" Sentence -> Sentence -> Sentence
`S.in_` r -> Sentence
forall r.
(HasUID r, HasRefAddress r, HasShortName r) =>
r -> Sentence
refS r
q
definedIn''' :: (HasSymbol q, HasUID q, Referable r, HasShortName r) => q -> r -> Sentence
definedIn''' :: q -> r -> Sentence
definedIn''' q :: q
q src :: r
src = q -> Sentence
forall c. (HasUID c, HasSymbol c) => c -> Sentence
ch q
q Sentence -> Sentence -> Sentence
`S.is` String -> Sentence
S "defined in" Sentence -> Sentence -> Sentence
+:+ r -> Sentence
forall r.
(HasUID r, HasRefAddress r, HasShortName r) =>
r -> Sentence
refS r
src
mkEnumAbbrevList :: Integer -> Sentence -> [Sentence] -> [(Sentence, ItemType)]
mkEnumAbbrevList :: Integer -> Sentence -> [Sentence] -> [(Sentence, ItemType)]
mkEnumAbbrevList s :: Integer
s t :: Sentence
t l :: [Sentence]
l = [Sentence] -> [ItemType] -> [(Sentence, ItemType)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Sentence
t Sentence -> Sentence -> Sentence
:+: String -> Sentence
S (Integer -> String
forall a. Show a => a -> String
show Integer
x) | Integer
x <- [Integer
s..]] ([ItemType] -> [(Sentence, ItemType)])
-> [ItemType] -> [(Sentence, ItemType)]
forall a b. (a -> b) -> a -> b
$ (Sentence -> ItemType) -> [Sentence] -> [ItemType]
forall a b. (a -> b) -> [a] -> [b]
map Sentence -> ItemType
Flat [Sentence]
l
fmtU :: (MayHaveUnit a) => Sentence -> a -> Sentence
fmtU :: Sentence -> a -> Sentence
fmtU n :: Sentence
n u :: a
u = Sentence
n Sentence -> Sentence -> Sentence
+:+ Maybe UnitDefn -> Sentence
unwrap (a -> Maybe UnitDefn
forall u. MayHaveUnit u => u -> Maybe UnitDefn
getUnit a
u)
typUncr :: HasUncertainty c => c -> Sentence
typUncr :: c -> Sentence
typUncr x :: c
x = Double -> Maybe Int -> Sentence
forall r a.
(Show r, RealFrac r, Integral a) =>
r -> Maybe a -> Sentence
found (c -> Double
forall x. HasUncertainty x => x -> Double
uncVal c
x) (c -> Maybe Int
forall x. HasUncertainty x => x -> Maybe Int
uncPrec c
x)
where
found :: r -> Maybe a -> Sentence
found u :: r
u Nothing = r -> Sentence
forall a. Show a => a -> Sentence
addPercent (r -> Sentence) -> r -> Sentence
forall a b. (a -> b) -> a -> b
$ r
u r -> r -> r
forall a. Num a => a -> a -> a
* 100
found u :: r
u (Just p :: a
p) = DecimalRaw Integer -> Sentence
forall a. Show a => a -> Sentence
addPercent (Word8 -> r -> DecimalRaw Integer
forall i r. (Integral i, RealFrac r) => Word8 -> r -> DecimalRaw i
realFracToDecimal (a -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
p) (r
u r -> r -> r
forall a. Num a => a -> a -> a
* 100) :: DecimalRaw Integer)
addPercent :: Show a => a -> Sentence
addPercent :: a -> Sentence
addPercent num :: a
num = String -> Sentence
S (a -> String
forall a. Show a => a -> String
show a
num) Sentence -> Sentence -> Sentence
:+: Sentence
Percent
zipSentList :: [[Sentence]] -> [Sentence] -> [[Sentence]] -> [[Sentence]]
zipSentList :: [[Sentence]] -> [Sentence] -> [[Sentence]] -> [[Sentence]]
zipSentList acc :: [[Sentence]]
acc _ [] = [[Sentence]]
acc
zipSentList acc :: [[Sentence]]
acc [] r :: [[Sentence]]
r = [[Sentence]]
acc [[Sentence]] -> [[Sentence]] -> [[Sentence]]
forall a. [a] -> [a] -> [a]
++ ([Sentence] -> [Sentence]) -> [[Sentence]] -> [[Sentence]]
forall a b. (a -> b) -> [a] -> [b]
map (Sentence
EmptySSentence -> [Sentence] -> [Sentence]
forall a. a -> [a] -> [a]
:) [[Sentence]]
r
zipSentList acc :: [[Sentence]]
acc (x :: Sentence
x:xs :: [Sentence]
xs) (y :: [Sentence]
y:ys :: [[Sentence]]
ys) = [[Sentence]] -> [Sentence] -> [[Sentence]] -> [[Sentence]]
zipSentList ([[Sentence]]
acc [[Sentence]] -> [[Sentence]] -> [[Sentence]]
forall a. [a] -> [a] -> [a]
++ [Sentence
xSentence -> [Sentence] -> [Sentence]
forall a. a -> [a] -> [a]
:[Sentence]
y]) [Sentence]
xs [[Sentence]]
ys
makeTMatrix :: Eq a => [Sentence] -> [[a]] -> [a] -> [[Sentence]]
makeTMatrix :: [Sentence] -> [[a]] -> [a] -> [[Sentence]]
makeTMatrix rowName :: [Sentence]
rowName rows :: [[a]]
rows cols :: [a]
cols = [[Sentence]] -> [Sentence] -> [[Sentence]] -> [[Sentence]]
zipSentList [] [Sentence]
rowName [[a] -> [a] -> [Sentence]
forall (t :: * -> *) (t :: * -> *) a.
(Foldable t, Foldable t, Eq a) =>
t a -> t a -> [Sentence]
zipFTable' [a]
x [a]
cols | [a]
x <- [[a]]
rows]
where
zipFTable' :: t a -> t a -> [Sentence]
zipFTable' content :: t a
content = (a -> [Sentence]) -> t a -> [Sentence]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (\x :: a
x -> if a
x a -> t a -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` t a
content then [String -> Sentence
S "X"] else [Sentence
EmptyS])
mkTableFromColumns :: [(Sentence, [Sentence])] -> ([Sentence], [[Sentence]])
mkTableFromColumns :: [(Sentence, [Sentence])] -> ([Sentence], [[Sentence]])
mkTableFromColumns l :: [(Sentence, [Sentence])]
l =
let l' :: [(Sentence, [Sentence])]
l' = ((Sentence, [Sentence]) -> Bool)
-> [(Sentence, [Sentence])] -> [(Sentence, [Sentence])]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool)
-> ((Sentence, [Sentence]) -> Bool)
-> (Sentence, [Sentence])
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Sentence -> Bool) -> [Sentence] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Sentence -> Bool
isEmpty ([Sentence] -> Bool)
-> ((Sentence, [Sentence]) -> [Sentence])
-> (Sentence, [Sentence])
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Sentence, [Sentence]) -> [Sentence]
forall a b. (a, b) -> b
snd) [(Sentence, [Sentence])]
l in
(((Sentence, [Sentence]) -> Sentence)
-> [(Sentence, [Sentence])] -> [Sentence]
forall a b. (a -> b) -> [a] -> [b]
map (Sentence, [Sentence]) -> Sentence
forall a b. (a, b) -> a
fst [(Sentence, [Sentence])]
l', [[Sentence]] -> [[Sentence]]
forall a. [[a]] -> [[a]]
transpose ([[Sentence]] -> [[Sentence]]) -> [[Sentence]] -> [[Sentence]]
forall a b. (a -> b) -> a -> b
$ ((Sentence, [Sentence]) -> [Sentence])
-> [(Sentence, [Sentence])] -> [[Sentence]]
forall a b. (a -> b) -> [a] -> [b]
map ((Sentence -> Sentence) -> [Sentence] -> [Sentence]
forall a b. (a -> b) -> [a] -> [b]
map Sentence -> Sentence
replaceEmptyS ([Sentence] -> [Sentence])
-> ((Sentence, [Sentence]) -> [Sentence])
-> (Sentence, [Sentence])
-> [Sentence]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Sentence, [Sentence]) -> [Sentence]
forall a b. (a, b) -> b
snd) [(Sentence, [Sentence])]
l')
where
isEmpty :: Sentence -> Bool
isEmpty EmptyS = Bool
True
isEmpty _ = Bool
False
replaceEmptyS :: Sentence -> Sentence
replaceEmptyS EmptyS = String -> Sentence
S "--"
replaceEmptyS s :: Sentence
s = Sentence
s
itemRefToSent :: String -> Sentence -> Sentence
itemRefToSent :: String -> Sentence -> Sentence
itemRefToSent a :: String
a b :: Sentence
b = String -> Sentence
S String
a Sentence -> Sentence -> Sentence
+:+ Sentence -> Sentence
sParen Sentence
b
makeListRef :: [a] -> Section -> [Sentence]
makeListRef :: [a] -> Section -> [Sentence]
makeListRef l :: [a]
l = Int -> Sentence -> [Sentence]
forall a. Int -> a -> [a]
replicate ([a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
l) (Sentence -> [Sentence])
-> (Section -> Sentence) -> Section -> [Sentence]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Section -> Sentence
forall r.
(HasUID r, HasRefAddress r, HasShortName r) =>
r -> Sentence
refS
bulletFlat :: [Sentence] -> ListType
bulletFlat :: [Sentence] -> ListType
bulletFlat = [(ItemType, Maybe String)] -> ListType
Bullet ([(ItemType, Maybe String)] -> ListType)
-> ([Sentence] -> [(ItemType, Maybe String)])
-> [Sentence]
-> ListType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ItemType] -> [(ItemType, Maybe String)]
noRefs ([ItemType] -> [(ItemType, Maybe String)])
-> ([Sentence] -> [ItemType])
-> [Sentence]
-> [(ItemType, Maybe String)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Sentence -> ItemType) -> [Sentence] -> [ItemType]
forall a b. (a -> b) -> [a] -> [b]
map Sentence -> ItemType
Flat
bulletNested :: [Sentence] -> [ListType] -> ListType
bulletNested :: [Sentence] -> [ListType] -> ListType
bulletNested t :: [Sentence]
t l :: [ListType]
l = [(ItemType, Maybe String)] -> ListType
Bullet ((Sentence -> ListType -> (ItemType, Maybe String))
-> [Sentence] -> [ListType] -> [(ItemType, Maybe String)]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\h :: Sentence
h c :: ListType
c -> (Sentence -> ListType -> ItemType
Nested Sentence
h ListType
c, Maybe String
forall a. Maybe a
Nothing)) [Sentence]
t [ListType]
l)
unwrap :: Maybe UnitDefn -> Sentence
unwrap :: Maybe UnitDefn -> Sentence
unwrap (Just a :: UnitDefn
a) = USymb -> Sentence
Sy (USymb -> Sentence) -> USymb -> Sentence
forall a b. (a -> b) -> a -> b
$ UnitDefn -> USymb
forall u. HasUnitSymbol u => u -> USymb
usymb UnitDefn
a
unwrap Nothing = Sentence
EmptyS
noRefs :: [ItemType] -> [(ItemType, Maybe String)]
noRefs :: [ItemType] -> [(ItemType, Maybe String)]
noRefs a :: [ItemType]
a = [ItemType] -> [Maybe String] -> [(ItemType, Maybe String)]
forall a b. [a] -> [b] -> [(a, b)]
zip [ItemType]
a ([Maybe String] -> [(ItemType, Maybe String)])
-> [Maybe String] -> [(ItemType, Maybe String)]
forall a b. (a -> b) -> a -> b
$ Maybe String -> [Maybe String]
forall a. a -> [a]
repeat Maybe String
forall a. Maybe a
Nothing
showingCxnBw :: NamedIdea c => c -> Sentence -> Sentence
showingCxnBw :: c -> Sentence -> Sentence
showingCxnBw traceyVar :: c
traceyVar contents :: Sentence
contents = c -> Sentence
forall n. NamedIdea n => n -> Sentence
titleize c
traceyVar Sentence -> Sentence -> Sentence
+:+
String -> Sentence
S "Showing the Connections Between" Sentence -> Sentence -> Sentence
+:+ Sentence
contents
underConsidertn :: ConceptChunk -> Sentence
underConsidertn :: ConceptChunk -> Sentence
underConsidertn chunk :: ConceptChunk
chunk = String -> Sentence
S "The" Sentence -> Sentence -> Sentence
+:+ ConceptChunk -> Sentence
forall n. (HasUID n, NamedIdea n) => n -> Sentence
phrase ConceptChunk
chunk Sentence -> Sentence -> Sentence
+:+
String -> Sentence
S "under consideration is" Sentence -> Sentence -> Sentence
+:+. (ConceptChunk
chunk ConceptChunk -> Getting Sentence ConceptChunk Sentence -> Sentence
forall s a. s -> Getting a s a -> a
^. Getting Sentence ConceptChunk Sentence
forall c. Definition c => Lens' c Sentence
defn)
refineChain :: NamedIdea c => [(c, Section)] -> Sentence
refineChain :: [(c, Section)] -> Sentence
refineChain [x :: (c, Section)
x,y :: (c, Section)
y] = String -> Sentence
S "The" Sentence -> Sentence -> Sentence
+:+ Section -> Sentence -> Sentence
forall r.
(HasUID r, HasRefAddress r, HasShortName r) =>
r -> Sentence -> Sentence
namedRef ((c, Section) -> Section
forall a b. (a, b) -> b
snd (c, Section)
x) (c -> Sentence
forall n. (HasUID n, NamedIdea n) => n -> Sentence
plural (c -> Sentence) -> c -> Sentence
forall a b. (a -> b) -> a -> b
$ (c, Section) -> c
forall a b. (a, b) -> a
fst (c, Section)
x) Sentence -> Sentence -> Sentence
`S.are` String -> Sentence
S "refined" Sentence -> Sentence -> Sentence
`S.toThe` c -> Sentence
forall n. (HasUID n, NamedIdea n) => n -> Sentence
plural ((c, Section) -> c
forall a b. (a, b) -> a
fst (c, Section)
y)
refineChain (x :: (c, Section)
x:y :: (c, Section)
y:xs :: [(c, Section)]
xs) = (SepType -> FoldType -> [Sentence] -> Sentence
foldlList SepType
Comma FoldType
List ([(c, Section)] -> Sentence
forall c. NamedIdea c => [(c, Section)] -> Sentence
refineChain [(c, Section)
x,(c, Section)
y] Sentence -> [Sentence] -> [Sentence]
forall a. a -> [a] -> [a]
: [(c, Section)] -> [Sentence]
forall b n.
(HasRefAddress b, HasShortName b, NamedIdea n, HasUID b) =>
[(n, b)] -> [Sentence]
rc ((c, Section)
y (c, Section) -> [(c, Section)] -> [(c, Section)]
forall a. a -> [a] -> [a]
: [(c, Section)]
xs)) Sentence -> Sentence
!.)
where
rc :: [(n, b)] -> [Sentence]
rc [a :: (n, b)
a, b :: (n, b)
b] = [(n, b) -> (n, b) -> Sentence
forall b b n n.
(HasRefAddress b, HasRefAddress b, HasShortName b, HasShortName b,
HasUID b, HasUID b, NamedIdea n, NamedIdea n) =>
(n, b) -> (n, b) -> Sentence
rcSent (n, b)
a (n, b)
b]
rc (a :: (n, b)
a:b :: (n, b)
b:as :: [(n, b)]
as) = (n, b) -> (n, b) -> Sentence
forall b b n n.
(HasRefAddress b, HasRefAddress b, HasShortName b, HasShortName b,
HasUID b, HasUID b, NamedIdea n, NamedIdea n) =>
(n, b) -> (n, b) -> Sentence
rcSent (n, b)
a (n, b)
b Sentence -> [Sentence] -> [Sentence]
forall a. a -> [a] -> [a]
: [(n, b)] -> [Sentence]
rc ((n, b)
b (n, b) -> [(n, b)] -> [(n, b)]
forall a. a -> [a] -> [a]
: [(n, b)]
as)
rc _ = String -> [Sentence]
forall a. HasCallStack => String -> a
error "refineChain helper encountered an unexpected empty list"
rcSent :: (n, b) -> (n, b) -> Sentence
rcSent a :: (n, b)
a b :: (n, b)
b = String -> Sentence
S "the" Sentence -> Sentence -> Sentence
+:+ b -> Sentence -> Sentence
forall r.
(HasUID r, HasRefAddress r, HasShortName r) =>
r -> Sentence -> Sentence
namedRef ((n, b) -> b
forall a b. (a, b) -> b
snd (n, b)
a) (n -> Sentence
forall n. (HasUID n, NamedIdea n) => n -> Sentence
plural (n -> Sentence) -> n -> Sentence
forall a b. (a -> b) -> a -> b
$ (n, b) -> n
forall a b. (a, b) -> a
fst (n, b)
a) Sentence -> Sentence -> Sentence
`S.toThe` b -> Sentence -> Sentence
forall r.
(HasUID r, HasRefAddress r, HasShortName r) =>
r -> Sentence -> Sentence
namedRef ((n, b) -> b
forall a b. (a, b) -> b
snd (n, b)
b) (n -> Sentence
forall n. (HasUID n, NamedIdea n) => n -> Sentence
plural ((n, b) -> n
forall a b. (a, b) -> a
fst (n, b)
b))
refineChain _ = String -> Sentence
forall a. HasCallStack => String -> a
error "refineChain encountered an unexpected empty list"
likelyFrame :: Sentence -> Sentence -> Sentence -> Sentence
likelyFrame :: Sentence -> Sentence -> Sentence -> Sentence
likelyFrame a :: Sentence
a verb :: Sentence
verb x :: Sentence
x = [Sentence] -> Sentence
foldlSent [String -> Sentence
S "The", Sentence
a, String -> Sentence
S "may be", Sentence
verb, Sentence
x]
maybeWOVerb, maybeChanged, maybeExpanded :: Sentence -> Sentence -> Sentence
maybeWOVerb :: Sentence -> Sentence -> Sentence
maybeWOVerb a :: Sentence
a = Sentence -> Sentence -> Sentence -> Sentence
likelyFrame Sentence
a Sentence
EmptyS
maybeChanged :: Sentence -> Sentence -> Sentence
maybeChanged a :: Sentence
a = Sentence -> Sentence -> Sentence -> Sentence
likelyFrame Sentence
a (String -> Sentence
S "changed")
maybeExpanded :: Sentence -> Sentence -> Sentence
maybeExpanded a :: Sentence
a = Sentence -> Sentence -> Sentence -> Sentence
likelyFrame Sentence
a (String -> Sentence
S "expanded")
tAndDWAcc :: Concept s => s -> ItemType
tAndDWAcc :: s -> ItemType
tAndDWAcc temp :: s
temp = Sentence -> ItemType
Flat (Sentence -> ItemType) -> Sentence -> ItemType
forall a b. (a -> b) -> a -> b
$ s -> Sentence
forall n. NamedIdea n => n -> Sentence
atStart s
temp Sentence -> Sentence -> Sentence
+:+. (Sentence -> Sentence
sParen (s -> Sentence
forall c. (Idea c, HasUID c) => c -> Sentence
short s
temp) Sentence -> Sentence -> Sentence
`sDash` Sentence -> Sentence
capSent (s
temp s -> Getting Sentence s Sentence -> Sentence
forall s a. s -> Getting a s a -> a
^. Getting Sentence s Sentence
forall c. Definition c => Lens' c Sentence
defn))
tAndDWSym :: (Concept s, Quantity a) => s -> a -> ItemType
tAndDWSym :: s -> a -> ItemType
tAndDWSym tD :: s
tD sym :: a
sym = Sentence -> ItemType
Flat (Sentence -> ItemType) -> Sentence -> ItemType
forall a b. (a -> b) -> a -> b
$ s -> Sentence
forall n. NamedIdea n => n -> Sentence
atStart s
tD Sentence -> Sentence -> Sentence
+:+. (Sentence -> Sentence
sParen (a -> Sentence
forall c. (HasUID c, HasSymbol c) => c -> Sentence
ch a
sym) Sentence -> Sentence -> Sentence
`sDash` Sentence -> Sentence
capSent (s
tD s -> Getting Sentence s Sentence -> Sentence
forall s a. s -> Getting a s a -> a
^. Getting Sentence s Sentence
forall c. Definition c => Lens' c Sentence
defn))
tAndDOnly :: Concept s => s -> ItemType
tAndDOnly :: s -> ItemType
tAndDOnly chunk :: s
chunk = Sentence -> ItemType
Flat (Sentence -> ItemType) -> Sentence -> ItemType
forall a b. (a -> b) -> a -> b
$ s -> Sentence
forall n. NamedIdea n => n -> Sentence
atStart s
chunk Sentence -> Sentence -> Sentence
`sDash` Sentence
EmptyS Sentence -> Sentence -> Sentence
+:+. Sentence -> Sentence
capSent (s
chunk s -> Getting Sentence s Sentence -> Sentence
forall s a. s -> Getting a s a -> a
^. Getting Sentence s Sentence
forall c. Definition c => Lens' c Sentence
defn)
follows :: (Referable r, HasShortName r) => Sentence -> r -> Sentence
preceding :: Sentence
preceding follows :: Sentence -> r -> Sentence
`follows` r :: r
r = Sentence
preceding Sentence -> Sentence -> Sentence
+:+ String -> Sentence
S "following" Sentence -> Sentence -> Sentence
+:+ r -> Sentence
forall r.
(HasUID r, HasRefAddress r, HasShortName r) =>
r -> Sentence
refS r
r
fromSource :: (Referable r, HasShortName r) => r -> Sentence
fromSource :: r -> Sentence
fromSource r :: r
r = Sentence -> Sentence
sParen (String -> Sentence
S "from" Sentence -> Sentence -> Sentence
+:+ r -> Sentence
forall r.
(HasUID r, HasRefAddress r, HasShortName r) =>
r -> Sentence
refS r
r)
fromSources :: (Referable r, HasShortName r) => [r] -> Sentence
fromSources :: [r] -> Sentence
fromSources rs :: [r]
rs = Sentence -> Sentence
sParen (String -> Sentence
S "from" Sentence -> Sentence -> Sentence
+:+ SepType -> FoldType -> [Sentence] -> Sentence
foldlList SepType
Comma FoldType
List ((r -> Sentence) -> [r] -> [Sentence]
forall a b. (a -> b) -> [a] -> [b]
map r -> Sentence
forall r.
(HasUID r, HasRefAddress r, HasShortName r) =>
r -> Sentence
refS [r]
rs))
getTandS :: (Quantity a) => a -> Sentence
getTandS :: a -> Sentence
getTandS a :: a
a = a -> Sentence
forall n. (HasUID n, NamedIdea n) => n -> Sentence
phrase a
a Sentence -> Sentence -> Sentence
+:+ a -> Sentence
forall c. (HasUID c, HasSymbol c) => c -> Sentence
ch a
a
displayStrConstrntsAsSet :: Quantity a => a -> [String] -> Sentence
displayStrConstrntsAsSet :: a -> [String] -> Sentence
displayStrConstrntsAsSet sym :: a
sym listOfVals :: [String]
listOfVals = ModelExpr -> Sentence
eS (ModelExpr -> Sentence) -> ModelExpr -> Sentence
forall a b. (a -> b) -> a -> b
$ ModelExpr -> Space -> ModelExpr
forall r. ModelExprC r => r -> Space -> r
isIn (a -> ModelExpr
forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy a
sym) ([String] -> Space
DiscreteS [String]
listOfVals)
displayDblConstrntsAsSet :: Quantity a => a -> [Double] -> Sentence
displayDblConstrntsAsSet :: a -> [Double] -> Sentence
displayDblConstrntsAsSet sym :: a
sym listOfVals :: [Double]
listOfVals = ModelExpr -> Sentence
eS (ModelExpr -> Sentence) -> ModelExpr -> Sentence
forall a b. (a -> b) -> a -> b
$ ModelExpr -> Space -> ModelExpr
forall r. ModelExprC r => r -> Space -> r
isIn (a -> ModelExpr
forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy a
sym) ([Double] -> Space
DiscreteD [Double]
listOfVals)
chgsStart :: (HasShortName x, Referable x) => x -> Sentence -> Sentence
chgsStart :: x -> Sentence -> Sentence
chgsStart = Sentence -> Sentence -> Sentence
sDash (Sentence -> Sentence -> Sentence)
-> (x -> Sentence) -> x -> Sentence -> Sentence
forall b c a. (b -> c) -> (a -> b) -> a -> c
. x -> Sentence
forall r.
(HasUID r, HasRefAddress r, HasShortName r) =>
r -> Sentence
refS
checkValidStr :: String -> String -> Either String String
checkValidStr :: String -> String -> Either String String
checkValidStr s :: String
s [] = String -> Either String String
forall a b. b -> Either a b
Right String
s
checkValidStr s :: String
s (x :: Char
x:xs :: String
xs)
| Char
x Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` String
s = 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
$ "Invalid character: \'" String -> String -> String
forall a. [a] -> [a] -> [a]
++ [Char
x] String -> String -> String
forall a. [a] -> [a] -> [a]
++ "\' in string \"" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
s String -> String -> String
forall a. [a] -> [a] -> [a]
++ ['\"']
| Bool
otherwise = String -> String -> Either String String
checkValidStr String
s String
xs
fterms :: (NamedIdea c, NamedIdea d) => (NP -> NP -> t) -> c -> d -> t
fterms :: (NP -> NP -> t) -> c -> d -> t
fterms f :: NP -> NP -> t
f a :: c
a b :: d
b = NP -> NP -> t
f (c
a c -> Getting NP c NP -> NP
forall s a. s -> Getting a s a -> a
^. Getting NP c NP
forall c. NamedIdea c => Lens' c NP
term) (d
b d -> Getting NP d NP -> NP
forall s a. s -> Getting a s a -> a
^. Getting NP d NP
forall c. NamedIdea c => Lens' c NP
term)