Joshua Moerman
8 years ago
8 changed files with 259 additions and 132 deletions
@ -0,0 +1,65 @@ |
|||
module Lazy.Zipper exposing (..) |
|||
|
|||
import Lazy exposing (Lazy) |
|||
import Lazy.List exposing (LazyList, (:::)) |
|||
|
|||
type alias Zipper a = |
|||
{ before : LazyList a |
|||
, focus : Lazy a |
|||
, after : LazyList a |
|||
} |
|||
|
|||
|
|||
{- Basic conversion -} |
|||
fromList : a -> List a -> Zipper a |
|||
fromList a l = Zipper Lazy.List.empty (pure a) (Lazy.List.fromList l) |
|||
|
|||
toList : Zipper a -> List a |
|||
toList rl = Lazy.List.toList (Lazy.List.reverse rl.before) ++ [Lazy.force rl.focus] ++ Lazy.List.toList rl.after |
|||
|
|||
{- Functor like things -} |
|||
map : (a -> b) -> Zipper a -> Zipper b |
|||
map f rl = Zipper (Lazy.List.map f rl.before) (Lazy.map f rl.focus) (Lazy.List.map f rl.after) |
|||
|
|||
edit : (a -> a) -> Zipper a -> Zipper a |
|||
edit f rl = Zipper rl.before (Lazy.map f rl.focus) rl.after |
|||
|
|||
{- Comonad functions -} |
|||
extract : Zipper a -> a |
|||
extract rl = rl.focus |> Lazy.force |
|||
|
|||
duplicate : Zipper a -> Zipper (Zipper a) |
|||
duplicate rl = let |
|||
lefts = iterate1N (Lazy.List.length rl.before) shiftRight rl |
|||
rights = iterate1N (Lazy.List.length rl.after) shiftLeft rl |
|||
in Zipper lefts (pure rl) rights |
|||
|
|||
extend : (Zipper a -> b) -> Zipper a -> Zipper b |
|||
extend f w = map f (duplicate w) |
|||
|
|||
(=>>) : Zipper a -> (Zipper a -> b) -> Zipper b |
|||
(=>>) = flip extend |
|||
|
|||
{- Domain functions -} |
|||
shiftLeft : Zipper a -> Zipper a |
|||
shiftLeft rl = case Lazy.List.headAndTail rl.after of |
|||
Just (x, xs) -> Zipper (Lazy.force rl.focus ::: rl.before) (pure x) xs |
|||
Nothing -> case Lazy.List.headAndTail (Lazy.List.reverse rl.before) of |
|||
Just (x, xs) -> Zipper (Lazy.List.singleton (Lazy.force rl.focus)) (pure x) xs |
|||
Nothing -> Zipper nil rl.focus nil |
|||
|
|||
shiftRight : Zipper a -> Zipper a |
|||
shiftRight rl = case Lazy.List.headAndTail rl.before of |
|||
Just (x, xs) -> Zipper xs (pure x) (Lazy.force rl.focus ::: rl.after) |
|||
Nothing -> case Lazy.List.headAndTail (Lazy.List.reverse rl.after) of |
|||
Just (x, xs) -> Zipper xs (pure x) (Lazy.List.singleton (Lazy.force rl.focus)) |
|||
Nothing -> Zipper nil rl.focus nil |
|||
|
|||
{- From here we have private functions -} |
|||
iterate1N : Int -> (a -> a) -> a -> LazyList a |
|||
iterate1N n f a = case n of |
|||
0 -> nil |
|||
m -> f a ::: Lazy.List.map f (iterate1N (m - 1) f a) |
|||
|
|||
nil = Lazy.List.empty |
|||
pure x = Lazy.lazy (always x) |
|||
@ -1,58 +0,0 @@ |
|||
module RingList exposing (..) |
|||
|
|||
type alias RingList a = |
|||
{ before : List a |
|||
, focus : a |
|||
, after : List a |
|||
} |
|||
|
|||
{- Basic conversion -} |
|||
fromList : a -> List a -> RingList a |
|||
fromList a l = RingList [] a l |
|||
|
|||
toList : RingList a -> List a |
|||
toList rl = List.reverse rl.before ++ [rl.focus] ++ rl.after |
|||
|
|||
{- Functor like things -} |
|||
map : (a -> b) -> RingList a -> RingList b |
|||
map f rl = RingList (List.map f rl.before) (f rl.focus) (List.map f rl.after) |
|||
|
|||
edit : (a -> a) -> RingList a -> RingList a |
|||
edit f rl = RingList rl.before (rl.focus |> f) rl.after |
|||
|
|||
{- Comonad functions -} |
|||
extract : RingList a -> a |
|||
extract rl = rl.focus |
|||
|
|||
duplicate : RingList a -> RingList (RingList a) |
|||
duplicate rl = let |
|||
lefts = iterate1N (List.length rl.before) shiftRight rl |
|||
rights = iterate1N (List.length rl.after) shiftLeft rl |
|||
in RingList lefts rl rights |
|||
|
|||
extend : (RingList a -> b) -> RingList a -> RingList b |
|||
extend f w = map f (duplicate w) |
|||
|
|||
(=>>) : RingList a -> (RingList a -> b) -> RingList b |
|||
(=>>) = flip extend |
|||
|
|||
{- Domain functions -} |
|||
shiftLeft : RingList a -> RingList a |
|||
shiftLeft rl = case rl.after of |
|||
[] -> case List.reverse rl.before of |
|||
[] -> RingList [] rl.focus [] |
|||
x::xs -> RingList [rl.focus] x xs |
|||
x::xs -> RingList (rl.focus :: rl.before) x xs |
|||
|
|||
shiftRight : RingList a -> RingList a |
|||
shiftRight rl = case rl.before of |
|||
[] -> case List.reverse rl.after of |
|||
[] -> RingList [] rl.focus [] |
|||
x::xs -> RingList xs x [rl.focus] |
|||
x::xs -> RingList xs x (rl.focus :: rl.after) |
|||
|
|||
{- From here we have private functions -} |
|||
iterate1N : Int -> (a -> a) -> a -> List a |
|||
iterate1N n f a = case n of |
|||
0 -> [] |
|||
m -> f a :: List.map f (iterate1N (m - 1) f a) |
|||
@ -0,0 +1,56 @@ |
|||
import Zipper exposing (..) |
|||
|
|||
import Color exposing (Color) |
|||
import Dict exposing (Dict) |
|||
import Html exposing (..) |
|||
import Html.App as App |
|||
import Html.Attributes exposing (style) |
|||
import Html.Events exposing (onClick) |
|||
import Random |
|||
import Time |
|||
|
|||
main = |
|||
App.program |
|||
{ init = init |
|||
, view = view |
|||
, update = update |
|||
, subscriptions = subscriptions |
|||
} |
|||
|
|||
size = 1000 |
|||
|
|||
-- MODEL |
|||
|
|||
type alias Model = Zipper Int |
|||
|
|||
init : (Model, Cmd Msg) |
|||
init = (fromList 0 [1..size], Cmd.none) |
|||
|
|||
|
|||
-- UPDATE |
|||
|
|||
type Msg = Update (Zipper Int) |
|||
|
|||
succ n = n + 1 |
|||
|
|||
update : Msg -> Model -> (Model, Cmd Msg) |
|||
update msg model = |
|||
case msg of |
|||
Update grid -> (edit succ grid, Cmd.none) |
|||
|
|||
|
|||
-- SUBSCRIPTIONS |
|||
|
|||
subscriptions : Model -> Sub Msg |
|||
subscriptions model = Sub.none |
|||
|
|||
|
|||
-- VIEW |
|||
|
|||
buttonView : Zipper Int -> Html Msg |
|||
buttonView zppr = button [onClick (Update zppr)] [text <| toString <| extract zppr] |
|||
|
|||
view model = let |
|||
butts = model =>> buttonView |
|||
listm = List.intersperse (br [] []) (toList butts) |
|||
in div [] listm |
|||
@ -0,0 +1,58 @@ |
|||
module Zipper exposing (..) |
|||
|
|||
type alias Zipper a = |
|||
{ before : List a |
|||
, focus : a |
|||
, after : List a |
|||
} |
|||
|
|||
{- Basic conversion -} |
|||
fromList : a -> List a -> Zipper a |
|||
fromList a l = Zipper [] a l |
|||
|
|||
toList : Zipper a -> List a |
|||
toList rl = List.reverse rl.before ++ [rl.focus] ++ rl.after |
|||
|
|||
{- Functor like things -} |
|||
map : (a -> b) -> Zipper a -> Zipper b |
|||
map f rl = Zipper (List.map f rl.before) (f rl.focus) (List.map f rl.after) |
|||
|
|||
edit : (a -> a) -> Zipper a -> Zipper a |
|||
edit f rl = Zipper rl.before (rl.focus |> f) rl.after |
|||
|
|||
{- Comonad functions -} |
|||
extract : Zipper a -> a |
|||
extract rl = rl.focus |
|||
|
|||
duplicate : Zipper a -> Zipper (Zipper a) |
|||
duplicate rl = let |
|||
lefts = iterate1N (List.length rl.before) shiftRight rl |
|||
rights = iterate1N (List.length rl.after) shiftLeft rl |
|||
in Zipper lefts rl rights |
|||
|
|||
extend : (Zipper a -> b) -> Zipper a -> Zipper b |
|||
extend f w = map f (duplicate w) |
|||
|
|||
(=>>) : Zipper a -> (Zipper a -> b) -> Zipper b |
|||
(=>>) = flip extend |
|||
|
|||
{- Domain functions -} |
|||
shiftLeft : Zipper a -> Zipper a |
|||
shiftLeft rl = case rl.after of |
|||
[] -> case List.reverse rl.before of |
|||
[] -> Zipper [] rl.focus [] |
|||
x::xs -> Zipper [rl.focus] x xs |
|||
x::xs -> Zipper (rl.focus :: rl.before) x xs |
|||
|
|||
shiftRight : Zipper a -> Zipper a |
|||
shiftRight rl = case rl.before of |
|||
[] -> case List.reverse rl.after of |
|||
[] -> Zipper [] rl.focus [] |
|||
x::xs -> Zipper xs x [rl.focus] |
|||
x::xs -> Zipper xs x (rl.focus :: rl.after) |
|||
|
|||
{- From here we have private functions -} |
|||
iterate1N : Int -> (a -> a) -> a -> List a |
|||
iterate1N n f a = case n of |
|||
0 -> [] |
|||
m -> f a :: List.map f (iterate1N (m - 1) f a) |
|||
Reference in new issue