Skip to content

Instantly share code, notes, and snippets.

@oisdk oisdk/ids.hs
Last active Dec 29, 2019

Embed
What would you like to do?
{-# LANGUAGE DeriveFunctor, LambdaCase, BlockArguments, BangPatterns, RankNTypes, GeneralisedNewtypeDeriving, OverloadedLists, TypeFamilies #-}
{-# OPTIONS_GHC -Wall #-}
import Control.Monad
import Control.Applicative
import Numeric.Natural
import GHC.Exts
import GHC.Base (build)
newtype List a = List { runList :: forall b. (a -> b -> b) -> b -> b } deriving Functor
instance IsList (List a) where
type Item (List a) = a
fromList xs = List \f b -> foldr f b xs
toList xs = build (runList xs)
instance Foldable List where
foldr f b xs = runList xs f b
instance Applicative List where
pure x = List \f -> f x
xs <*> ys = List \f -> runList xs \x -> runList ys \y -> f (x y)
instance Monad List where
xs >>= k = List \f -> runList xs \x -> runList (k x) f
instance Alternative List where
empty = mempty
(<|>) = (<>)
instance Semigroup (List a) where
xs <> ys = List (\f -> runList xs f . runList ys f)
instance Monoid (List a) where
mempty = List (\_ b -> b)
newtype Search a
= Search
{ runSearch :: Natural -> List a
} deriving (Functor, Semigroup, Monoid)
instance Applicative Search where
pure x = Search \case
0 -> pure x
_ -> empty
fs <*> xs =
Search \n -> do
i <- [0..n]
let j = n - i
f <- runSearch fs i
x <- runSearch xs j
pure (f x)
instance Alternative Search where
empty = mempty
(<|>) = (<>)
instance Monad Search where
xs >>= f = Search \n -> do
i <- [0..n]
x <- runSearch xs i
runSearch (f x) (n - i)
toStream :: Search a -> [a]
toStream xs = toList ([0..] >>= runSearch xs)
searchFrom :: Natural -> Search Natural
searchFrom n = Search (pure . (+) n)
pyth :: Search (Natural,Natural,Natural)
pyth = do
x <- searchFrom 1
y <- searchFrom 1
z <- searchFrom 1
guard (x*x + y*y == z*z)
guard (x <= y)
guard (x > 10)
pure (x,y,z)
find :: Search a -> a
find xs = go 0
where
go !n = runList (runSearch xs n) const (go (n+1))
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
You can’t perform that action at this time.