Last active
December 9, 2016 17:47
-
-
Save sasha1sum/e4323e22cb63f0e179ef6f2c69d20c82 to your computer and use it in GitHub Desktop.
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
module PPAP where | |
-- Objects are either a unit of something (Thing) or some combination (Union) | |
data Object = Thing String | |
| Union Object Object | |
instance Show Object where | |
show (Thing name) = name | |
show (Union a b) = show a ++ "-" ++ show b | |
-- Some simple constructors | |
-- unions merging the thing on the right with the left after flipping the thing on the right | |
-- this is the same as combining left to right, pivoting on the left, and "reading" top to bottom | |
union :: Object -> Object -> Object | |
union a b = Union (flip b) a | |
where flip :: Object -> Object | |
flip (Thing t) = Thing t | |
flip (Union a b) = Union b a | |
thing = Thing | |
-- simple method for describing objects | |
describe :: Object -> IO () | |
describe (Thing s) = putStrLn $ "I have a " ++ s ++ "..." | |
describe ab@(Union a b) = putStrLn $ show ab ++ "..." | |
-- simple description of the act of combining | |
combine :: Object -> Object -> IO Object | |
combine a b = do | |
let ab = union a b | |
describe a | |
describe b | |
putStrLn "*Unh*" | |
putStrLn $ show ab ++ "!" | |
putStrLn "" | |
return ab | |
-- sample program which combines a bunch of objects | |
main = do | |
let pen = thing "Pen" | |
let apple = thing "Apple" | |
let pineapple = thing "Pineapple" | |
putStrLn "PPAP" | |
putStrLn "" | |
ap <- combine pen apple | |
pp <- combine pen pineapple | |
combine ap pp |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment