{-# LANGUAGE DataKinds #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE PolyKinds #-}
module Data.Memorable.Theme.Fantasy where

import Data.Memorable

type TransitiveVerb = ToTree
    '[ "blending"
     , "breaking"
     , "bullying"
     , "burning"
     , "charming"
     , "dominating"
     , "fighting"
     , "freezing"
     , "growing"
     , "kicking"
     , "killing"
     , "liquefying"
     , "loving"
     , "melting"
     , "paralyzing"
     , "peeling"
     , "petrifying"
     , "piercing"
     , "pinching"
     , "poking"
     , "punching"
     , "singeing"
     , "slicing"
     , "splattering"
     , "squishing"
     , "tearing"
     , "teasing"
     , "throwing"
     , "tormenting"
     , "tossing"
     , "wooing"
     , "zapping"
     ]

type Weapons = ToTree
    '[ "axe"
     , "club"
     , "dagger"
     , "dart"
     , "flail"
     , "halberd"
     , "hammer"
     , "javelin"
     , "lance"
     , "mace"
     , "pick"
     , "sling"
     , "spear"
     , "staff"
     , "sword"
     , "trident"
     ]

type Armour = ToTree
    '[ "helm"
     , "boots"
     , "vest"
     , "gauntlets"
     , "great helm"
     , "cuirasse"
     , "shield"
     , "pants"
     , "shirt"
     , "greaves"
     , "hat"
     , "leggings"
     , "robes"
     , "sandals"
     , "amulet"
     , "ring"
     ]

type Aura = ToTree
    '[ "unholy"
     , "holy"
     , "sacred"
     , "vile"
     , "shimmering"
     , "glowing"
     , "sparkling"
     , "demonic"
     , "angelic"
     , "cold"
     , "terrifying"
     , "ancient"
     , "mouldy"
     , "elvish"
     , "apocryphal"
     , "ghostly"
     ]

type Monster = ToTree
    '[ "batrachian"
     , "afreet"
     , "ankheg"
     , "annis"
     , "assagim"
     , "babau"
     , "babbler"
     , "banshee"
     , "barghest"
     , "basilisk"
     , "behir"
     , "blindheim"
     , "blinkdog"
     , "brownie"
     , "bugbear"
     , "bulette"
     , "carbuncle"
     , "caterwaul"
     , "centaur"
     , "chimaera"
     , "cockatrice"
     , "crabman"
     , "cyclops"
     , "dakon"
     , "demoniac"
     , "devilcat"
     , "disenchanter"
     , "doppelganger"
     , "dracolisk"
     , "dragon"
     , "dretch"
     , "dryad"
     , "elemental"
     , "erinyes"
     , "ettercap"
     , "ettin"
     , "faun"
     , "gargoyle"
     , "genie"
     , "ghast"
     , "ghost"
     , "ghoul"
     , "giant"
     , "gnoll"
     , "goblin"
     , "golem"
     , "gorgon"
     , "griffon"
     , "grimlock"
     , "harpy"
     , "hellhound"
     , "hippogriff"
     , "hobgoblin"
     , "homonculus"
     , "hydra"
     , "imp"
     , "jackalwere"
     , "kobold"
     , "kraken"
     , "lemure"
     , "leprechaun"
     , "lich"
     , "locathah"
     , "manticore"
     , "medusa"
     , "mephit"
     , "merman"
     , "minotaur"
     , "mongrelman"
     , "mould"
     , "mummy"
     , "naga"
     , "necrophidius"
     , "nereid"
     , "nightmare"
     , "nilbog"
     , "nixie"
     , "nymph"
     , "ogre"
     , "orc"
     , "otyugh"
     , "owlbear"
     , "pegasus"
     , "phantom"
     , "phoenix"
     , "piercer"
     , "pixie"
     , "poltergeist"
     , "pseudodragon"
     , "quasit"
     , "quickling"
     , "rakshasa"
     , "remorhaz"
     , "roc"
     , "roper"
     , "sahuagin"
     , "shaitan"
     , "shedu"
     , "shrieker"
     , "shub"
     , "skeleton"
     , "spectre"
     , "sphinx"
     , "sprite"
     , "squealer"
     , "stirge"
     , "stunjelly"
     , "succubus"
     , "sylph"
     , "titan"
     , "treant"
     , "triton"
     , "troglodyte"
     , "troll"
     , "uduk"
     , "unicorn"
     , "vampire"
     , "vilstrak"
     , "volt"
     , "vulchling"
     , "wererat"
     , "werewolf"
     , "wight"
     , "wraith"
     , "wyvern"
     , "xorn"
     , "yeti"
     , "zombie"
     ]

type ArmourMaterial = ToTree
    '[ "bronze"
     , "cloth"
     , "golden"
     , "iron"
     , "leather"
     , "silk"
     , "studded"
     , "wooden"
     , "crystal"
     , "mythril"
     , "bone"
     , "stone"
     , "silver"
     , "glass"
     , "paper"
     , "fur"
     ]

type Buff = ToTree
    '[ "accuracy"
     , "climbing"
     , "constitution"
     , "dexterity"
     , "fear"
     , "fortitude"
     , "hope"
     , "invisibility"
     , "paralysis"
     , "protection"
     , "speed"
     , "swimming"
     , "telekinesis"
     , "warmth"
     , "wisdom"
     , "wizardry"
     ]

type RpgWeapons = Weapons :- "of" :- Monster :- TransitiveVerb

type RpgArmour = ArmourMaterial :- Armour :- "of" :- Buff

{-
rpgThings = aura .- (w .| a)
    where
        w = Proxy :: Proxy RpgWeapons
        a = Proxy :: Proxy RpgArmour
        aura = Proxy :: Proxy Aura
-}

rpgWeapons :: Proxy (Aura :- RpgWeapons)
rpgWeapons = Proxy

rpgArmour :: Proxy (Aura :- RpgArmour)
rpgArmour = Proxy