Skip to content

Instantly share code, notes, and snippets.

@queertypes
Created March 3, 2017 18:29
Show Gist options
  • Star 0 You must be signed in to star a gist
  • Fork 0 You must be signed in to fork a gist
  • Save queertypes/75d0568cd7e228058652a98e76655e10 to your computer and use it in GitHub Desktop.
Save queertypes/75d0568cd7e228058652a98e76655e10 to your computer and use it in GitHub Desktop.
Haskell and Terraria, with opaleye and psql.
create extension "uuid-ossp";
create type herb as enum (
'daybloom',
'moonglow',
'blinkroot',
'waterleaf',
'deathweed',
'shiverthorn',
'fireblossom'
);
create type fish as enum (
'armored_cavefish',
'crimson_tigerfish',
'variegated_lardfish',
'ebonkoi',
'prismite'
);
create type ore as enum (
'gold',
'iron',
'obsidian'
);
create type potionType as enum (
'combat',
'exploring',
'fishing'
);
create table if not exists potions (
id uuid primary key default uuid_generate_v4(),
pName text not null,
pType potionType not null,
herbs herb[] not null,
fishes fish[] not null,
ores ore[] not null,
other text[] not null,
requiresLimitedItems bool not null,
durationMinutes serial2 not null
);
create view combatPotions as (
select * from potions where pType = 'combat'
);
create view explorationPotions as (
select * from potions where pType = 'exploring'
);
create view fishingPotions as (
select * from potions where pType = 'fishing'
);
create view potionsNeedingFish as (
select * from potions where fishes != '{}'
);
create view potionsNeedingLimitedItems as (
select * from potions where requiresLimitedItems = true
);
insert into potions (pName, pType, herbs, fishes, ores, other, requiresLimitedItems, durationMinutes) values
('builder', 'exploring', '{"blinkroot", "shiverthorn", "moonglow"}', '{}', '{}', '{}', false, 15),
('crate', 'fishing', '{"deathweed", "moonglow"}', '{}', '{}', '{"amber"}', true, 3),
('dangersense', 'exploring', '{"shiverthorn"}', '{}', '{}', '{"cobweb:10"}', false, 10),
('endurance', 'combat', '{"blinkroot"}', '{"armored_cavefish"}', '{}', '{}', false, 4),
('fishing', 'fishing', '{"waterleaf"}', '{}', '{}', '{"crispy_honey_block"}', false, 8),
('heartreach', 'combat', '{"daybloom"}', '{"crimson_tigerfish"}', '{}', '{}', false, 8),
('hunter', 'exploring', '{"daybloom", "blinkroot"}', '{}', '{}', '{"shark_fin"}', false, 5),
('iron skin', 'combat', '{"daybloom"}', '{}', '{"iron"}', '{}', false, 5),
('lifeforce', 'combat', '{"moonglow", "shiverthorn", "waterleaf"}', '{"prismite"}', '{}', '{}', false, 5),
('mana regen', 'combat', '{"moonglow", "daybloom"}', '{}', '{}', '{"fallen_star"}', false, 7),
('mining', 'exploring', '{"blinkroot"}', '{}', '{}', '{"antlion_mandible"}', false, 8),
('night owl', 'exploring', '{"daybloom", "blinkroot"}', '{}', '{}', '{}', false, 4),
('obsidian skin', 'exploring', '{"fireblossom", "waterleaf"}', '{}', '{"obsidian"}', '{}', false, 4),
('regen', 'combat', '{"daybloom"}', '{}', '{}', '{"mushroom"}', false, 4),
('sonar', 'fishing', '{"waterleaf"}', '{}', '{}', '{"coral"}', true, 4),
('shine', 'exploring', '{"daybloom"}', '{}', '{}', '{"glowing_mushroom"}', false, 5),
('spelunker', 'exploring', '{"blinkroot", "moonglow"}', '{}', '{"gold"}', '{}', false, 5),
('summoning', 'combat', '{"moonglow"}', '{"variegated_lardfish"}', '{}', '{}', false, 6),
('swiftness', 'exploring', '{"blinkroot"}', '{}', '{}', '{"cactus"}', false, 4),
('wrath', 'combat', '{"deathweed"}', '{"ebonkoi"}', '{}', '{}', false, 4)
-----------------------------------------------------------------------------
-- |
-- Module : Types
-- Copyright : Copyright (C) 2017 Allele Dev
-- License : GPL-3 (see the file LICENSE)
-- Maintainer : allele.dev@gmail.com
-- Stability : provisional
-- Portability : portable
--
-- Just a clump of stuff for now. Data model, sql, query runners.
-----------------------------------------------------------------------------
{-# LANGUAGE Arrows #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE TemplateHaskell #-}
{-# OPTIONS -Wall #-}
module Types where
import YNotPrelude
import Control.Arrow
import Data.UUID (UUID)
import Data.Profunctor.Product.TH
import Data.Text (pack)
import Database.PostgreSQL.Simple.FromField
import Opaleye
import qualified Data.ByteString.Char8 as B
import qualified Database.PostgreSQL.Simple as PGS
import qualified Prelude as P
data Herb
= Daybloom
| Moonglow
| Blinkroot
| Waterleaf
| Shiverthorn
| Deathweed
| Fireblossom
| UnknownHerb Text
deriving Show
data Ore
= Iron
| Gold
| Obsidian
| UnknownOre Text
deriving Show
data Fish
= ArmoredCavefish
| CrimsonTigerfish
| VariegatedLardfish
| Ebonkoi
| Prismite
| UnknownFish Text
deriving Show
data PotionType
= Exploring
| Combat
| Fishing
| UnknownPotionType Text
deriving Show
instance FromField PotionType where
fromField _ mdata = return $ case B.unpack <$> mdata of
(Just "combat") -> Combat
(Just "exploring") -> Exploring
(Just "fishing") -> Fishing
(Just x) -> UnknownPotionType (pack x)
Nothing -> _
instance FromField Herb where
fromField _ mdata = return $ case B.unpack <$> mdata of
(Just "daybloom") -> Daybloom
(Just "moonglow") -> Moonglow
(Just "blinkroot") -> Blinkroot
(Just "waterleaf") -> Waterleaf
(Just "shiverthorn") -> Shiverthorn
(Just "deathweed") -> Deathweed
(Just "fireblossom") -> Fireblossom
(Just x) -> UnknownHerb (pack x)
Nothing -> _
instance FromField Fish where
fromField _ mdata = return $ case B.unpack <$> mdata of
(Just "armored_cavefish") -> ArmoredCavefish
(Just "crimson_tigerfish") -> CrimsonTigerfish
(Just "variegated_lardfish") -> VariegatedLardfish
(Just "ebonkoi") -> Ebonkoi
(Just "prismite") -> Prismite
(Just x) -> UnknownFish (pack x)
Nothing -> _
instance FromField Ore where
fromField _ mdata = return $ case B.unpack <$> mdata of
(Just "iron") -> Iron
(Just "gold") -> Gold
(Just "obsidian") -> Obsidian
(Just x) -> UnknownOre (pack x)
Nothing -> _
instance QueryRunnerColumnDefault PGText PotionType where
queryRunnerColumnDefault = fieldQueryRunnerColumn
instance QueryRunnerColumnDefault PGText Herb where
queryRunnerColumnDefault = fieldQueryRunnerColumn
instance QueryRunnerColumnDefault PGText Fish where
queryRunnerColumnDefault = fieldQueryRunnerColumn
instance QueryRunnerColumnDefault PGText Ore where
queryRunnerColumnDefault = fieldQueryRunnerColumn
newtype PotionName' a = PotionName a
$(makeAdaptorAndInstance "pPotionName" ''PotionName')
type PotionName = PotionName' Text
type PotionNameCol = PotionName' (Column PGText)
newtype DurationMinutes' a = DurationMinutes a
$(makeAdaptorAndInstance "pDurationMinutes" ''DurationMinutes')
type DurationMinutesCol = DurationMinutes' (Column PGInt4)
type DurationMinutes = DurationMinutes' Int
data Potions' a b c d e f g h i =
Potions { id :: a
, potionName :: b
, potionType :: c
, herbs :: d
, fishes :: e
, ores :: f
, otherItems :: g
, requiresLimitedItems :: h
, durationMinutes :: i
}
type Potions =
Potions' UUID PotionName PotionType [Herb] [Fish] [Ore] [Text] Bool DurationMinutes
-- Potions' UUID Text Text [Text] [Text] [Text] [Text] Bool DurationMinutes
deriving instance Show DurationMinutes
deriving instance Show PotionName
deriving instance Show Potions
type PotionsSQL =
Potions' (Column PGUuid) -- id
PotionNameCol -- name
(Column PGText) -- potion type
(Column (PGArray PGText)) -- herbs
(Column (PGArray PGText)) -- fishes
(Column (PGArray PGText)) -- ores
(Column (PGArray PGText)) -- others
(Column PGBool) -- requires limited items
DurationMinutesCol -- duration minutes
$(makeAdaptorAndInstance "pPotions" ''Potions')
potionsTable :: Table PotionsSQL PotionsSQL
potionsTable =
Table "potions" (pPotions Potions { id = required "id"
, potionName = pPotionName (PotionName (required "pname"))
, potionType = required "ptype"
, herbs = required "herbs"
, fishes = required "fishes"
, ores = required "ores"
, otherItems = required "other"
, requiresLimitedItems = required "requireslimiteditems"
, durationMinutes = pDurationMinutes (DurationMinutes (required "durationminutes"))
})
potionsQuery :: Query PotionsSQL
potionsQuery = queryTable potionsTable
doPotionsQuery :: IO ()
doPotionsQuery = do
conn <- PGS.connectPostgreSQL "dbname='terraria' user='allele'"
ret <- query conn
mapM_ (P.putStrLn . show) ret
where query :: PGS.Connection -> IO [Potions]
query c = runQuery c potionsQuery
namesOres :: Query (PotionNameCol, Column (PGArray PGText))
namesOres = proc () -> do
p <- potionsQuery -< ()
returnA -< (potionName p, ores p)
doNamesOresQuery :: IO ()
doNamesOresQuery = do
conn <- PGS.connectPostgreSQL "dbname='terraria' user='allele'"
ret <- query conn
mapM_ (P.putStrLn . show) ret
where query :: PGS.Connection -> IO [(PotionName, [Ore])]
query c = runQuery c namesOres
durationQuery :: Column PGInt4 -> Query PotionsSQL
durationQuery n = proc () -> do
p <- potionsQuery -< ()
restrict -< (\(DurationMinutes n') -> n' .> n) (durationMinutes p)
returnA -< p
doDurationQuery :: IO ()
doDurationQuery = do
conn <- PGS.connectPostgreSQL "dbname='terraria' user='allele'"
ret <- query conn
mapM_ (P.putStrLn . show) ret
where query :: PGS.Connection -> IO [Potions]
query c = runQuery c (durationQuery 5)
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment