interfacesgist.elm

import Graphics.Element exposing (show)

type Mappable a b ma mb = Mappable
  { map : (a -> b) -> ma -> mb }
  
  
map : (a -> b) -> ma -> { ext | mappable : Mappable a b ma mb } -> mb
map f m {mappable} = case mappable of
  Mappable {map} -> map f m
  
  
mappable m map = 
  { m | mappable = Mappable { map = map } }
  
  
type Reducible a b ma = Reducible
  { reduce : (a -> b -> b) -> b -> ma -> b }
    

reduce : (a -> b -> b) -> b -> ma -> { ext | reducible : Reducible a b ma } -> b
reduce f b m {reducible} = case reducible of
  Reducible {reduce} -> reduce f b m
  
reducible m reduce = 
  { m | reducible = Reducible { reduce = reduce } }
  
  
sum : ma -> { ext | reducible : Reducible Float Float ma } -> Float
sum = reduce (+) 0

product : ma -> { ext | reducible : Reducible Float Float ma } -> Float
product = reduce (*) 1

  
type Conjable a ma = Conjable 
  { conj : a -> ma -> ma }
  
  
conj : a -> ma -> { ext | conjable : Conjable a ma } -> ma
conj a ma {conjable} = case conjable of
  Conjable {conj} -> conj a ma
  
conjable m conj = 
  { m | conjable = Conjable { conj = conj } }
  
  
type Emptyable m = Emptyable 
  { empty : m }
  
  
empty : { ext | emptyable : Emptyable m } -> m 
empty {emptyable} = case emptyable of
  Emptyable {empty} -> empty
  
emptyable m empty = 
  { m | emptyable = Emptyable { empty = empty } }
  
  
type Appendable m = Appendable
  { append : m -> m -> m }
  

append : m -> m -> { ext | appendable : Appendable m } -> m
append m n {appendable} = case appendable of 
  Appendable {append} -> append m n
  
appendable m append = 
  { m | appendable = Appendable { append = append } }

  
  
type Flattenable mm m = Flattenable
  { flatten : mm -> m }
  
  
flatten : mm -> { ext | flattenable : Flattenable mm m } -> m
flatten m {flattenable} = case flattenable of
  Flattenable {flatten} -> flatten m
  
  
flattenable m flatten = 
  { m | flattenable = Flattenable { flatten = flatten } }
  

(<<) : (b -> interface -> c) -> (a -> interface -> b) -> a -> interface -> c
(<<) f g x interface = 
  f (g x interface) interface
  
  
flatMap : (a -> mb) -> ma -> { ext | mappable : Mappable a mb ma mmb, flattenable : Flattenable mmb mb } -> mb
flatMap f = flatten << map f
  


  
listInterface = {} 
 `mappable` List.map
 `reducible` List.foldl
 `conjable` (::)
 `emptyable` []
 `appendable` (++)
 `flattenable` (List.foldr (++) [])
 
 
test = flatMap (\x -> List.repeat x 3) [1..4] listInterface

main = show test