sjoerdvisscher

{-# LANGUAGE TypeFamilies, DeriveFunctor, DeriveFoldable #-}
module HAD.Y2014.M04.D01.Exercise where

import Prelude hiding (any, elem)
import Data.Reify
import Control.Applicative
import Data.Foldable
import Data.Monoid
import Data.Maybe
import System.IO.Unsafe

sjoerdvisscher

{-# LANGUAGE RankNTypes, FlexibleContexts, ScopedTypeVariables #-}
import Data.Reflection
import Data.Constraint
import GHC.Exts (Any)
import Unsafe.Coerce (unsafeCoerce)

test :: ((Int, Int), (Bool, Bool))
test = give (close givePair) $ give (3 :: Int) $ give True $ (open given, open given)

givePair :: Given a => (a, a)

sjoerdvisscher

{-# LANGUAGE RankNTypes, GADTs #-}
module Free (FreeCat(..), singleton, null) where

import Prelude hiding ((.), id, null)
import Control.Applicative
import Control.Category

import Catenated
import View

sjoerdvisscher

listTraversal :: (Strong p, Monoidal (p [a])) => p a b -> p [a] [b]
listTraversal p = dimap f g $ _2 $ ap2 (nil, cons)
  where
    f as = (as, as)
    g ([], (bs, _)) = bs
    g (_ , (_, bs)) = bs
    nil = return []
    cons = return (:) `ap` lmap Prelude.head p `ap` lmap Prelude.tail (listTraversal p)

sjoerdvisscher

newtype CoArb a = CoArb { unCoArb :: forall b. a -> Gen b -> Gen b }

instance Contravariant CoArb where
  contramap f (CoArb g) = CoArb $ \a -> g (f a)

instance Divisible CoArb where
  divide f (CoArb g) (CoArb h) = CoArb $ \a -> case f a of
    (b, c) -> g b . h c
  conquer = CoArb $ const id

sjoerdvisscher

protocol Semigroup {
    func +(x: Self, y:Self) -> Self
}
extension String: Semigroup {}
extension Int: Semigroup {}

func foldMap1<A, M : Semigroup, S : SequenceType where S.Generator.Element == A>(t: S, f: A -> M) -> M? {
    var g = t.generate()
    if let x0 = g.next() {
        var x = f(x0)

sjoerdvisscher

struct Rect {
    var width = 1
    var height = 1
    
    mutating func scaleBy(value: Int) {
        width *= value
        height *= value
    }
}

sjoerdvisscher

import Foundation

enum JSONValue: StringLiteralConvertible, FloatLiteralConvertible, DictionaryLiteralConvertible, ArrayLiteralConvertible, Equatable, DebugPrintable {
    case JSONString(String)
    case JSONNumber(Double)
    case JSONObject([String: JSONValue])
    case JSONArray([JSONValue])
    init(stringLiteral value: String) {
        self = JSONString(value)
    }

sjoerdvisscher

import Control.Monad.Free -- from category-extras

data WebF r = Display String r | Form String (String -> r)

instance Functor WebF where
  fmap f (Display m r) = Display m (f r)
  fmap f (Form m g)    = Form m (f . g)

type Web = Free WebF

sjoerdvisscher

{-# LANGUAGE GADTs, KindSignatures #-}

data Val = B Int | Unit | Pair Val Val | In1 Val | In2 Val | Closr (Val -> Cnt -> Ans) | Contx Val Cnt
type Cnt = Val -> Ans
type Env = Ide -> Either Val Cnt

type Ans = IO ()
type Ide = String

data E :: * -> * where