Coverage report

module Test1 exposing (main)

import Html
import Json.Decode
import Random
import Tracery


seed : Random.Seed
seed =
Random.initialSeed 42


main =
"""
{ "origin":
["#greeting##emoji# #funFact# #fact# #outro#"
, "#fact# #funFact# #greeting# #emoji#"
]
, "greeting":
[ "Hi #emoji##emoji#"
, "I like pizza"
, "What are you looking at? "
, "single af"
, "brain"
, "Hi im awesome"
, "Im new here"
, "Im different"
]
, "number": ["1,20", "1,50", "2,0","2,4"," hard to get","#age#"]
, "age": ["16","17","18","19","20","21","22","23","24","25","26","27","28","29","30","33","35","too old for you", "too young for you", "old enough #emoji#"]
, "funFact":
[ "love #love#"
, "Im #number#"
, "#study# student"
, "#funFact# #funFact#"
]
, "fact":
[ "Have a Ph.D. in snuggling"
, "Fun is my first name."
, "fun at home, fun alone"
, "it takes to two to bugalow"
, "not interested in dating"
, "im the one you're looking for"
, "you'll be the pretty one"
,"moved here for work"
, "Im exactly as I look"
, "Way prettier in real life"
, "My ex would recommend me"
]
, "love":
[ "sushi 🍣"
, "cats 😺\u{200B}"
, "dogs 🐕"
, "coffee"
]
, "study":
[ "psychology", "science", "arts", "law" ]
, "outro":
[ "random"
, "no bad jokes pls"
, "swipe right if youre #swipeRightIf#"
, "10/10 would fuck again"
, "pls be nice"
, "One Love"
, "like it rough"
, "dont swipe right if youre #swipeRightIf#"
]
, "swipeRightIf":["ready for #readyFor#","ugly","my ex","into #love#"]
, "readyFor":["action #emoji#","my hips #emoji#","some love #emoji#","#emoji#"]
, "emoji":["👅","\u{200B}🔥\u{200B}","\u{200B}👀\u{200B}","\u{200B}👻\u{200B}","🤪","💪","❤"]
}
"""
|> Tracery.fromJson
|> (\result ->
case result of
Err err ->
Json.Decode.errorToString err

Ok generator ->
Random.step generator seed
|> Tuple.first
)
|> Html.text

module Tracery exposing (fromJson, run, runTo, toString)

{-| Tracery is a text-generation language mostly used for twitter bots.

See [Tracery.io](www.tracery.io) for more information.

@docs fromJson, run, runTo, toString

-}

import Json.Decode
import Json.Value exposing (JsonValue(..))
import Parser exposing ((|.), (|=))
import Random exposing (Generator)
import Set
import Tracery.Command exposing (Command(..))
import Tracery.Grammar exposing (Grammar)
import Tracery.Syntax exposing (Definition(..), Expression(..))


{-| Turns a tracery json-string into a generator

import Json.Decode
import Random
import Result.Extra

generate : Int -> String -> String
generate seed json =
json
|> Tracery.fromJson
|> Result.Extra.unpack
Json.Decode.errorToString
(\grammar ->
Random.step (Tracery.run grammar) (Random.initialSeed seed)
|> Tuple.first
)

A tracery json is a object that has a `origin` field.

The `#` and `\` characters need to be escaped.

"""
{ "origin": "The \\\\# and \\\\\\\\ characters need to be escaped."}
"""
|> generate 42
--> "The # and \\ characters need to be escaped."

If you provide a list, tracer will tick an element at random.

"""
{ "origin": ["I like cats","I like dogs"]}
"""
|> generate 42
--> "I like cats"

You can reference other fields using `#..#`

"""
{ "origin": ["I have two pets: a #pet# and a #pet#"]
, "pet": ["cat","dog","fish","parrot"]
}
"""
|> generate 42
--> "I have two pets: a dog and a cat"

Definitions may also be recursive.

"""
{ "origin": ["I have #pets#"]
, "pets": ["a #pet#","a #pet# and #pets#"]
, "pet": ["cat","dog","fish","parrot"]
}
"""
|> generate 20
--> "I have a fish and a cat and a dog"

You can define constants by providing a string instead of a list.

"""
{ "origin": ["My #favoritePet# is the best #favoritePet# in the world"]
, "favoritePet" : "#pet#"
, "pet": ["cat","dog","fish","parrot"]
}
"""
|> generate 42
--> "My dog is the best dog in the world"

You may define sub-definitions to organize your definitions.

"""
{ "origin": ["My #cat#","My #dog#"]
, "cat":
{ "origin":"cat is named #name#"
, "name": ["Cleopatra","Cesar"]
}
, "dog":
{ "origin":"dog is named #name#"
, "name": ["Athena","Zeus"]
}
}
"""
|> generate 42
--> "My cat is named Cleopatra"

-}
fromJson : String -> Result Json.Decode.Error Grammar
fromJson string =
string |> Tracery.Syntax.fromString |> Result.map Tracery.Grammar.fromDefinitions


{-| Runs a grammar until it ends.

Some recursive definitions might take a long time.

Use `runTo` if you want to avoid long waiting times.

-}
run : Grammar -> Generator String
run grammar =
grammar
|> Tracery.Grammar.generateWhile (\_ -> True)
|> Random.map (Tracery.Grammar.toString (\_ -> ""))


{-| Will just write the current output.

use run or runTo, to actually compute something.

-}
toString : ({ variable : String } -> String) -> Grammar -> String
toString fun =
Tracery.Grammar.toString fun


{-| Runs a grammar until it reaches a key in the list.

import Json.Decode
import Random
import Result.Extra

generateTo : List String -> ({variable:String} -> String)-> Int -> String -> String
generateTo list fun seed json =
json
|> Tracery.fromJson
|> Result.Extra.unpack
Json.Decode.errorToString
(\grammar ->
Random.step (Tracery.runTo list grammar) (Random.initialSeed seed)
|> Tuple.first
|> toString fun
)

"""
{ "origin": ["A #color# #animal#"]
, "color": ["black","white","gray"]
, "animal":
[ "cat, looking at a #color# #animal#"
, "bird."
]
}
"""
|> generateTo ["animal"] (\{variable} -> "dog.") 42
--> "A black dog."

-}
runTo : List String -> Grammar -> Generator Grammar
runTo list =
let
set =
Set.fromList list
in
Tracery.Grammar.generateWhile
(\g ->
case g.next of
Just (Print (Variable string)) ->
not (Set.member string set)

_ ->
True
)

module Tracery.Command exposing
( Command(..), simplify, toString
, fillAll, fromExpressions, holes
)

{-| Commands are used to be able to pause the execution of a Grammar.

By modifying the commands in a grammar you can directly change how the program should run.

@docs Command, simplify, toString

@docs fillAll, fromExpressions, holes

-}

import Dict exposing (Dict)
import Random exposing (Generator)
import Tracery.Syntax exposing (Definition, Expression(..))


type Command
= Print Expression
| Define (Dict String Definition)
| Delete (List String)
| Save { asConstant : String, replaceWith : List Command }


fromExpressions : List Expression -> List Command
fromExpressions =
List.map Print


holes : List Command -> List String
holes =
List.filterMap
(\exp ->
case exp of
Print (Variable string) ->
Just string

_ ->
Nothing
)


fillAll : (String -> Generator (List Command)) -> List Command -> Generator (List Command)
fillAll fun =
List.foldl
(\exp ->
Random.andThen
(\list ->
(case exp of
Print (Variable string) ->
fun string

_ ->
exp |> List.singleton |> Random.constant
)
|> Random.map (\e -> list ++ e)
)
)
(Random.constant [])


simplify : List Command -> List Command
simplify list =
case list of
[] ->
[]

head :: rest ->
rest
|> List.foldl
(\exp ( h, l ) ->
case ( exp, h ) of
( Print (Value a), Print (Value b) ) ->
( (b ++ a) |> Value |> Print, l )

_ ->
( exp, h :: l )
)
( head, [] )
|> (\( a, b ) -> a :: b)


toString : (String -> String) -> List Command -> String
toString fun list =
list
|> List.foldl
(\cmd out ->
case cmd of
Print exp ->
case exp of
Variable string ->
out ++ fun string

Value string ->
out ++ string

Save { replaceWith } ->
"[Save]" ++ toString fun replaceWith

Define _ ->
"[Define]"

Delete _ ->
"[Delete]"
)
""

module Tracery.Grammar exposing
( Grammar, fromDefinitions
, generateWhile, generateOutput, generateNext
, Strategy, defaultStrategy, noRecursionStrategy, onlyRecursionStrategy
, toNext, withCommands
, end, rewind, toString
)

{-| Creates a string generator based on a syntax.


# Grammar

@docs Grammar, fromDefinitions


# Generating

@docs generateWhile, generateOutput, generateCommands, generateNext


# Strategy

@docs Strategy, defaultStrategy, noRecursionStrategy, onlyRecursionStrategy


# Technical Utilities

@docs toNext, withCommands

-}

import Dict exposing (Dict)
import Json.Value exposing (JsonValue(..))
import Random exposing (Generator)
import Set exposing (Set)
import Tracery.Command exposing (Command(..))
import Tracery.Syntax exposing (Definition(..), Expression(..))


{-|

- `next` - what needs to be generated next?
- `constants` - what
- `definitions` - the grammar rules (see Syntax)

-}
type alias Grammar =
{ output : List Command
, stack : List Command
, next : Maybe Command
, constants : Dict String (List Command)
, definitions : Dict String Definition
}


{-| Turns Definitions into a Grammar.
-}
fromDefinitions : Dict String Definition -> Grammar
fromDefinitions syntax =
{ output = []
, stack = []
, next = Just (Print (Variable Tracery.Syntax.originString))
, constants = Dict.empty
, definitions = syntax
}


{-| sets the output as input.
-}
rewind : Grammar -> Grammar
rewind grammar =
grammar
|> end
|> (\g -> { g | output = [] } |> withCommands g.output)


{-| set the remaining commands as output
-}
end : Grammar -> Grammar
end grammar =
{ grammar
| output =
grammar.output
++ (grammar.next
|> Maybe.map List.singleton
|> Maybe.withDefault []
)
++ grammar.stack
, next = Nothing
, stack = []
}


{-| Prints the Grammar
-}
toString : ({ variable : String } -> String) -> Grammar -> String
toString fun grammar =
grammar
|> end
|> .output
|> Tracery.Command.toString (\variable -> fun { variable = variable })


{-| Sets Commands of a Grammar.
-}
withCommands : List Command -> Grammar -> Grammar
withCommands trace grammar =
case trace of
[] ->
{ grammar | next = Nothing }

head :: tail ->
{ grammar
| next = Just head
, stack = tail
}


{-| Moves to the next command without executing anything.

toNext : Grammar -> Grammar
toNext grammar =
grammar |> withCommands grammar.stack

-}
toNext : Grammar -> Grammar
toNext grammar =
grammar |> withCommands grammar.stack


{-| Generates a string while a predicate is valid
-}
generateWhile : (Grammar -> Bool) -> Grammar -> Generator Grammar
generateWhile fun grammar =
grammar
|> generateOutput fun defaultStrategy
|> Random.andThen
(while (\g -> fun g && Tracery.Command.holes g.output /= [])
(\g ->
g
|> rewind
|> generateOutput fun defaultStrategy
)
)


{-| Generates an output found in the resulting grammar.

You can use `generateCommands` instead, If you intend to get the output right away.

import Dict
import Json.Decode
import Random exposing (Generator)
import Result.Extra
import Tracery.Syntax exposing (Definition(..), Expression(..))
import Set

andThenToString : ({ variable : String } -> String) -> Int -> (Grammar -> Generator Grammar) -> Grammar -> String
andThenToString fun seed gen grammar =
Random.step (gen grammar) (Random.initialSeed seed)
|> Tuple.first
|> toString fun

input : Grammar
input =
[ ( "origin", Choose [ [ Value "A ", Variable "animal" ] ] )
, ( "animal"
, Choose
[ [ Value "cat, looking at a ", Variable "animal" ]
, [ Value "bird." ]
]
)
]
|> Dict.fromList
|> fromDefinitions

input
|> andThenToString (\{variable} -> "dog.") 42 (generateOutput (\_ -> True) defaultStrategy)
--> "A cat, looking at a cat, looking at a cat, looking at a cat, looking at a bird."

input
|> andThenToString (\{variable} -> "dog.") 42 (generateOutput (\_ -> True) (noRecursionStrategy (Set.fromList ["animal"])))
--> "A bird."

-}
generateOutput : (Grammar -> Bool) -> Strategy -> Grammar -> Generator Grammar
generateOutput fun strategy =
while (\g -> fun g && g.next /= Nothing)
(generateNext strategy)


while : (Grammar -> Bool) -> (Grammar -> Generator Grammar) -> Grammar -> Generator Grammar
while fun do init =
do init
|> Random.andThen
(\g ->
if fun g then
while fun do g

else
Random.constant g
)


{-| Computes the command in `grammar.next`.

Afterwards the next command gets loaded

import Dict
import Json.Decode
import Random exposing (Generator)
import Result.Extra
import Tracery.Syntax exposing (Definition(..), Expression(..))

andThenToString : ({ variable : String } -> String) -> Int -> (Grammar -> Generator Grammar) -> Grammar -> String
andThenToString fun seed gen grammar =
Random.step (gen grammar) (Random.initialSeed seed)
|> Tuple.first
|> toString fun

input : Grammar
input =
[ ( "origin", Choose [ [ Value "A ", Variable "animal" ] ] )
, ( "animal"
, Choose
[ [ Value "cat, looking at a ", Variable "animal" ]
, [ Value "bird." ]
]
)
]
|> Dict.fromList
|> fromDefinitions

using this function, you can step through the computation

input
|> andThenToString (\{variable} -> "dog.") 42 (generateNext defaultStrategy)
--> "A dog."

The second step does nothing (some steps only perform internal rearrangements)

input
|> andThenToString (\{variable} -> "dog.") 42
(\g -> g
|> (generateNext defaultStrategy)
|> Random.andThen (generateNext defaultStrategy)
)
--> "A dog."

Doing a second step results in

input
|> andThenToString (\{variable} -> "dog.") 42
(\g -> g
|> (generateNext defaultStrategy)
|> Random.andThen (generateNext defaultStrategy)
|> Random.andThen (generateNext defaultStrategy)
)
--> "A cat, looking at a dog."

-}
generateNext : Strategy -> Grammar -> Generator Grammar
generateNext strategy grammar =
(case grammar.next of
Just next ->
case next of
Print (Variable k0) ->
Dict.get k0 grammar.definitions
|> Maybe.map
(generateFromDefinition k0
grammar
strategy
)
|> Maybe.withDefault
({ grammar | output = [ "error: " ++ k0 ++ " does not exist" |> Value |> Print ] }
|> Random.constant
)

Print (Value string) ->
Random.constant { grammar | output = grammar.output ++ [ string |> Value |> Print ] }

Define dict ->
{ grammar | definitions = grammar.definitions |> Dict.union dict }
|> Random.constant

Delete list ->
{ grammar | definitions = list |> List.foldl Dict.remove grammar.definitions }
|> Random.constant

Save { asConstant, replaceWith } ->
{ grammar
| constants = grammar.constants |> Dict.insert asConstant grammar.output
, output = replaceWith
}
|> Random.constant

Nothing ->
Random.constant grammar
)
|> Random.map (\g -> { g | output = Tracery.Command.simplify g.output } |> toNext)


generateFromDefinition :
String
-> Grammar
-> Strategy
-> Definition
-> Generator Grammar
generateFromDefinition k0 grammar strategy definition =
case definition of
Choose statements ->
(case List.filter (strategy k0) statements of
[] ->
Random.constant []

head :: tail ->
Random.uniform head tail
)
|> Random.map
(\stack ->
{ grammar | stack = Tracery.Command.fromExpressions stack ++ grammar.stack }
)

Let statement ->
case grammar.constants |> Dict.get k0 of
Just stack ->
{ grammar | output = grammar.output ++ stack }
|> Random.constant

Nothing ->
Random.constant
{ grammar
| output = []
, stack =
Tracery.Command.fromExpressions statement
++ [ Save { asConstant = k0, replaceWith = grammar.output }
, Print (Variable k0)
]
++ grammar.stack
}

With subDefinitions ->
Random.constant
{ grammar
| stack =
[ Tracery.Syntax.originString |> Variable |> Print
, subDefinitions |> Dict.keys |> Delete
]
++ grammar.stack
, definitions =
subDefinitions
|> Dict.union
(grammar.definitions
|> Dict.remove Tracery.Syntax.originString
)
}



-----------------------------------------------------------------------------------------------------
-- Strategies
-----------------------------------------------------------------------------------------------------


{-| The strategy specifies the algorithm to choose an option
-}
type alias Strategy =
String -> List Expression -> Bool


{-| This strategy will never choose a recursive option
-}
noRecursionStrategy : Set String -> Strategy
noRecursionStrategy set key list =
(Set.member key set |> not)
|| List.all
(\exp ->
case exp of
Value _ ->
True

Variable string ->
key /= string
)
list


{-| This strategy will only chose recursive options
-}
onlyRecursionStrategy : Set String -> Strategy
onlyRecursionStrategy set key list =
(Set.member key set |> not)
|| List.any
(\exp ->
case exp of
Value _ ->
True

Variable string ->
key == string
)
list


{-| This strategy will choose any option
-}
defaultStrategy : Strategy
defaultStrategy _ _ =
True

module Tracery.Syntax exposing
( Expression(..), Definition(..)
, decoder, fromString, originString
)

{-| This modules exposes the internal structures of the package.

Its intended to be used in combination with some preprocessing.

@docs Expression, Definition
@docs decoder, fromString, originString

-}

import Dict exposing (Dict)
import Json.Decode
import Json.Value exposing (JsonValue(..))
import Parser exposing ((|.), (|=), Parser)
import Result.Extra
import Set


{-| The expressions always return a string

- `Value` - just return the given string
- `Variable` - look up the key and insert a generated string according to the definition of the key.

-}
type Expression
= Value String
| Variable String


{-| The definition specifies how the strings gets generated

- `Choose` - Choose a random sentence out of a list.
- `Let` - Generate the sentence one. Then use the sentence over and over again.
- `With` - Generate the sentence according to the sub-grammar.

-}
type Definition
= Choose (List (List Expression))
| Let (List Expression)
| With (Dict String Definition)


{-| The origin is the starting point for the generated story.

originString : String
originString =
"origin"

-}
originString : String
originString =
"origin"


isValid : List String -> Dict String Definition -> Result String ()
isValid oldKeys dict =
let
keys =
dict |> Dict.keys |> (++) oldKeys

verify k sentences =
if
List.any
(\sentenceKeys ->
not (List.member k sentenceKeys)
)
sentences
then
sentences
|> List.concat
|> List.filterMap
(\sentenceKey ->
if List.member sentenceKey keys then
Nothing

else
Just sentenceKey
)
|> (\l ->
case l of
[] ->
Ok ()

[ a ] ->
"In the definition of "
++ k
++ " the variable "
++ a
++ " is not defined. Defined is "
++ (keys ++ oldKeys |> String.join ", ")
|> Err

head :: tail ->
"In the definition of "
++ k
++ " the variables "
++ (tail |> String.join ", ")
++ " and "
++ head
++ " are not defined."
|> Err
)

else
"The definition of "
++ k
++ " needs an option that does not contain itself."
|> Err
in
dict
|> Dict.toList
|> List.map
(\( k, v ) ->
if k /= originString && List.member k oldKeys then
Err (k ++ " has already been defined.")

else
case v of
Choose l ->
l
|> List.map
(\sentence ->
sentence
|> List.filterMap
(\exp ->
case exp of
Value _ ->
Nothing

Variable key ->
Just key
)
)
|> verify k

Let l ->
l
|> List.filterMap
(\exp ->
case exp of
Value _ ->
Nothing

Variable key ->
Just key
)
|> List.singleton
|> verify k

With subSyntax ->
isValid keys subSyntax
)
|> Result.Extra.combine
|> Result.map (\_ -> ())


{-|

import Dict exposing (Dict)
import Tracery.Command exposing (Command(..))

input : String
input =
"""{ "origin" : [ "Hello \\\\\\\\ World \\\\#", "#statement# and #statement#" ]
, "statement" :
{ "origin" : "my #myPet# is the #complement#"
, "myPet": "#pet#"
, "pet" : ["cat","dog"]
, "complement" : ["smartest #myPet# in the world","fastest #myPet# that i know of"]
}
}"""

output : Dict String Definition
output =
Dict.fromList
[ ( "origin"
, Choose
[ [ (Value "Hello "), (Value "\\"), (Value " World "), (Value "#")]
, [ (Variable "statement"), (Value " and "), (Variable "statement")]
]
)
, ( "statement"
, Dict.fromList
[ ( "origin"
, [ (Value "my ")
, (Variable "myPet")
, (Value " is the ")
, (Variable "complement")
]
|> Let
)
, ( "myPet",Let [ (Variable "pet")])
, ( "pet", Choose [[ (Value "cat")],[ (Value "dog")]])
, ( "complement"
, Choose
[ [ (Value "smartest "), (Variable "myPet"), (Value " in the world")]
, [ (Value "fastest "), (Variable "myPet"), (Value " that i know of")]
]
)
]
|> With
)
]

input |> fromString
--> Ok output

-}
fromString : String -> Result Json.Decode.Error (Dict String Definition)
fromString =
Json.Decode.decodeString decoder


{-| Decoder for the Syntax.
-}
decoder : Json.Decode.Decoder (Dict String Definition)
decoder =
Json.Value.decoder
|> Json.Decode.andThen
(\jsonValue ->
jsonValue
|> decodeSyntax
|> Result.andThen
(\syntax ->
syntax
|> isValid []
|> Result.map (\() -> syntax)
)
|> Result.map Json.Decode.succeed
|> Result.Extra.extract Json.Decode.fail
)


decodeSyntax : JsonValue -> Result String (Dict String Definition)
decodeSyntax jsonValue =
case jsonValue of
ObjectValue list ->
list
|> List.map
(\( k, v ) ->
decodeDefinition v
|> Result.map (\ok -> ( k, ok ))
)
|> Result.Extra.combine
|> Result.map Dict.fromList

_ ->
errorString
{ expected = "an object"
, got = jsonValue
}
|> Err


decodeDefinition : JsonValue -> Result String Definition
decodeDefinition jsonValue =
case jsonValue of
StringValue string ->
string
|> Parser.run sentenceParser
|> Result.mapError (\_ -> "")
|> Result.map Let

ArrayValue l ->
l
|> List.map
(\sentence ->
case sentence of
StringValue string ->
string
|> Parser.run sentenceParser
|> Result.mapError (\_ -> "")

_ ->
errorString
{ expected = "a string"
, got = sentence
}
|> Err
)
|> Result.Extra.combine
|> Result.map Choose

ObjectValue _ ->
decodeSyntax jsonValue
|> Result.map With

_ ->
errorString
{ expected = "a string, list or object"
, got = jsonValue
}
|> Err


sentenceParser : Parser (List Expression)
sentenceParser =
Parser.loop []
(\list ->
Parser.oneOf
[ Parser.succeed (\stmt -> Parser.Loop (stmt :: list))
|= expressionParser
, Parser.succeed ()
|> Parser.map (\_ -> Parser.Done (List.reverse list))
]
)


expressionParser : Parser Expression
expressionParser =
let
validChar char =
char /= '#' && char /= '\\'

variable =
Parser.variable
{ start = validChar
, inner = validChar
, reserved = Set.empty
}
in
Parser.oneOf
[ variable
|> Parser.map Value
, Parser.succeed (Value "\\")
|. Parser.token "\\\\"
, Parser.succeed (Value "#")
|. Parser.token "\\#"
, Parser.succeed Variable
|. Parser.token "#"
|= variable
|. Parser.token "#"
]


errorString : { expected : String, got : JsonValue } -> String
errorString args =
"expected " ++ args.expected ++ " but got " ++ toString args.got ++ "."


toString : JsonValue -> String
toString jsonValue =
case jsonValue of
ObjectValue list ->
"{ " ++ (list |> List.map (\( k, v ) -> k ++ " : " ++ toString v) |> String.join ", ") ++ " }"

ArrayValue list ->
"[ " ++ (list |> List.map toString |> String.join ", ") ++ " ]"

BoolValue bool ->
if bool then
"True"

else
"False"

NullValue ->
"Null"

NumericValue float ->
float |> String.fromFloat

StringValue string ->
"\"" ++ string ++ "\""