let { Bool, Option, Result, Ordering } = import! "std/types.glu"
/// A linked list type
type List a = | Nil | Cons a (List a)
let unwrap opt : Option a -> a =
match opt with
| Some x -> x
| None -> error "Option was None"
let unwrap_ok res : Result e a -> a =
match res with
| Ok x -> x
| Err _ -> error "Result was an Err"
let unwrap_err res : Result e a -> e =
match res with
| Ok _ -> error "Result was an Ok"
| Err x -> x
/**
`Monoid m` represents an associative operation on `m` an which has an identity.
This means the following laws must hold:
* x <> empty = x
* empty <> x = x
* x <> (y <> z) = (x <> y) <> z
*/
type Monoid m = {
append : m -> m -> m,
empty : m
}
let monoid_Function m : Monoid b -> (Monoid (a -> b)) = {
append = \f g -> \x -> m.append (f x) (g x),
empty = \_ -> m.empty
}
let monoid_Option m : Monoid a -> Monoid (Option a) = {
append = \l r ->
match (l, r) with
| (Some x, Some y) -> Some (m.append x y)
| (Some _, None) -> l
| (None, Some _) -> r
| (None, None) -> None,
empty = None
}
let monoid_Int_Add = {
append = \x y -> x #Int+ y,
empty = 0
}
let monoid_Int_Mul = {
append = \x y -> x #Int* y,
empty = 1
}
let monoid_Float_Add = {
append = \x y -> x #Float+ y,
empty = 0.0
}
let monoid_Float_Mul = {
append = \x y -> x #Float* y,
empty = 1.0
}
let make_Monoid m =
let { append, empty } = m
let (<>) /* : m -> m -> m */ = append
{ append, empty, (<>) }
let not x = if x then False else True
/// `Eq a` defines equality (==) on `a`
type Eq a = {
(==) : a -> a -> Bool
}
let eq_Unit : Eq () = {
(==) = \l r -> True
}
let eq_Bool : Eq Bool = {
(==) = \l r -> if l then r else not r
}
let eq_Int = {
(==) = \l r -> l #Int== r
}
let eq_Float = {
(==) = \l r -> l #Float== r
}
let eq_Char = {
(==) = \l r -> l #Char== r
}
let eq_Option a : Eq a -> Eq (Option a) = {
(==) = \l r ->
match (l, r) with
| (Some l_val, Some r_val) -> a.(==) l_val r_val
| (None, None) -> True
| _ -> False
}
let eq_Result e a : Eq e -> Eq a -> Eq (Result e a) = {
(==) = \l r ->
match (l, r) with
| (Ok l_val, Ok r_val) -> a.(==) l_val r_val
| (Err l_val, Err r_val) -> e.(==) l_val r_val
| _ -> False
}
let monoid_Ordering = {
append = \x y ->
match x with
| EQ -> y
| _ -> x,
empty = EQ
}
/// `Ord a` defines an ordering on `a`
type Ord a = {
eq : Eq a,
compare : a -> a -> Ordering
}
let ord_Unit = {
eq = eq_Unit,
compare = \l r -> EQ
}
let ord_Bool = {
eq = eq_Bool,
compare = \l r ->
if l then
if r then
EQ
else
GT
else
LT
}
let ord_Int = {
eq = eq_Int,
compare = \l r ->
if l #Int< r
then LT
else if l #Int== r
then EQ
else GT
}
let ord_Float = {
eq = eq_Float,
compare = \l r ->
if l #Float< r
then LT
else if l #Float== r
then EQ
else GT
}
let ord_Char = {
eq = eq_Char,
compare = \l r ->
if l #Char< r
then LT
else if l #Char== r
then EQ
else GT
}
let ord_Option a : Ord a -> Ord (Option a) = {
eq = eq_Option a.eq,
compare = \l r ->
match (l, r) with
| (Some l_val, Some r_val) -> a.compare l_val r_val
| (None, Some _) -> LT
| (Some _, None) -> GT
| (None, None) -> EQ
}
let ord_Result e a : Ord e -> Ord a -> Ord (Result e a) = {
eq = eq_Result e.eq a.eq,
compare = \l r ->
match (l, r) with
| (Ok l_val, Ok r_val) -> a.compare l_val r_val
| (Err l_val, Err r_val) -> e.compare l_val r_val
| (Ok _, Err _) -> LT
| (Err _, Ok _) -> GT
}
/// Creates the `<=`, `<`, `>` and `>=` operators from an instance with `Ord`
let make_Ord ord =
let { eq, compare } = ord
{
eq,
compare,
(<=) = \l r ->
match compare l r with
| LT -> True
| EQ -> True
| GT -> False,
(<) = \l r ->
match compare l r with
| LT -> True
| EQ -> False
| GT -> False,
(>) = \l r ->
match compare l r with
| LT -> False
| EQ -> False
| GT -> True,
(>=) = \l r ->
match compare l r with
| LT -> False
| EQ -> True
| GT -> True
}
/**
The basic operation on numbers.
Defined for both the primitive type `Int` and `Float`
*/
type Num a = {
ord : Ord a,
(+) : a -> a -> a,
(-) : a -> a -> a,
(*) : a -> a -> a,
(/) : a -> a -> a,
negate : a -> a
}
let num_Int = {
ord = ord_Int,
(+) = monoid_Int_Add.append,
(-) = \l r -> l #Int- r,
(*) = monoid_Int_Mul.append,
(/) = \l r -> l #Int/ r,
negate = \x -> 0 #Int- x
}
let num_Float : Num Float = {
ord = ord_Float,
(+) = monoid_Float_Add.append,
(-) = \l r -> l #Float- r,
(*) = monoid_Float_Mul.append,
(/) = \l r -> l #Float/ r,
negate = \x -> 0.0 #Float- x
}
type Category (cat : Type -> Type -> Type) = {
id : cat a a,
compose : cat b c -> cat a b -> cat a c
}
let category_Function : Category (->) = {
id = \x -> x,
compose = \f g x -> f (g x)
}
let make_Category cat =
let { id, compose } = cat
/// Right-to-left composition. Alias for `compose`.
let (<<) /* : cat b c -> cat a b -> cat a c */ = compose
/// Left-to-right composition. Alias for `compose`, but with the arguments flipped.
let (>>) f g /* : cat a b -> cat b c -> cat a c */ = compose g f
{ id, compose, (<<), (>>) }
/// The identity function, where `id x == x`
let id : a -> a =
category_Function.id
/// flip `f` takes creates a new function which takes its two arguments in reverse order
let flip f : (a -> b -> c) -> b -> a -> c =
\x y -> f y x
/// Backward function application, where `f <| x == f x`
let (<|) f x : (a -> b) -> a -> b = f x
/// Forward function application, where `x |> f == f x`
let (|>) x f : a -> (a -> b) -> b = f x
/// Right-to-left function composition
let (<<) : (b -> c) -> (a -> b) -> a -> c =
(make_Category category_Function).(<<)
/// Left-to-right function composition
let (>>) : (a -> b) -> (b -> c) -> a -> c =
(make_Category category_Function).(>>)
/**
A `Functor` represents an action on a parameterized type which does not change the structure with
the mapped type.
*/
type Functor (f : Type -> Type) = {
map : (a -> b) -> f a -> f b
}
let functor_Function : Functor ((->) a) = {
map = category_Function.compose
}
let functor_Option : Functor Option = {
map = \f x ->
match x with
| Some y -> Some (f y)
| None -> None
}
let functor_Result : Functor (Result e) = {
map = \f x ->
match x with
| Ok y -> Ok (f y)
| Err _ -> x
}
let functor_IO : Functor IO = {
map = \f -> io_flat_map (\x -> io_pure (f x))
}
type Applicative (f : Type -> Type) = {
functor : Functor f,
apply : f (a -> b) -> f a -> f b,
pure : a -> f a
}
let applicative_Function : Applicative ((->) a) = {
functor = functor_Function,
apply = \f g x -> f x (g x),
pure = \x -> \_ -> x
}
/// const `x` creates a function which always returns `x`
let const : a -> b -> a =
applicative_Function.pure
let applicative_Option : Applicative Option = {
functor = functor_Option,
apply = \f x ->
match (f, x) with
| (Some g, Some y) -> Some (g y)
| _ -> None,
pure = \x -> Some x
}
let applicative_Result : Applicative (Result e) = {
functor = functor_Result,
apply = \f x ->
match (f, x) with
| (Ok g, Ok y) -> Ok (g y)
| (Ok _, Err _) -> x
| (Err x, _) -> Err x,
pure = \x -> Ok x
}
let applicative_IO : Applicative IO =
let pure = io_pure
let apply f x = io_flat_map (\g -> io_flat_map (\y -> pure (g y)) x) f
{ functor = functor_IO, apply, pure }
let make_Applicative app =
let { functor, apply, pure } = app
let (<*>) /* : app (a -> b) -> app a -> app b */ = apply
let (<*) l r /* : app a -> app b -> app a */ = functor.map const l <*> r
let (*>) l r /* : app a -> app b -> app b */ = functor.map (const id) l <*> r
let map2 f a b /* : (a -> b -> c) -> app a -> app b -> app c */ = (functor.map f a) <*> b
let map3 f a b c /* : (a -> b -> c -> d) -> app a -> app b -> app c -> app d */ = (functor.map f a) <*> b <*> c
{ functor, apply, pure, (<*>), (<*), (*>), map2, map3 }
type Alternative f = {
applicative : Applicative f,
or : f a -> f a -> f a,
empty : f a
}
let alternative_Option : Alternative Option = {
applicative = applicative_Option,
or = \x y ->
match x with
| Some _ -> x
| None -> y,
empty = None
}
let make_Alternative f =
let { applicative, or, empty } = f
let { functor, (<*>), pure } = make_Applicative applicative
let (<|>) /* : f a -> f a -> f a */ = or
let many x /* : f a -> f (List a) */ =
let many_v _ = some_v () <|> pure Nil
and some_v _ = functor.map (\h l -> Cons h l) x <*> many_v ()
many_v ()
let some x /* : f a -> f (List a) */ =
let many_v _ = some_v () <|> pure Nil
and some_v _ = functor.map (\h l -> Cons h l) x <*> many_v ()
some_v ()
{ applicative, or, empty, (<|>), many, some }
type Monad (m : Type -> Type) = {
applicative : Applicative m,
flat_map : (a -> m b) -> m a -> m b
}
let monad_Function : Monad ((->) a) = {
applicative = applicative_Function,
flat_map = \f m x -> f (m x) x
}
let monad_Option : Monad Option = {
applicative = applicative_Option,
flat_map = \f m ->
match m with
| Some x -> f x
| None -> None
}
let monad_IO : Monad IO = {
applicative = applicative_IO,
flat_map = io_flat_map
}
let make_Monad m =
let { applicative, flat_map } = m
let { (*>), pure } = make_Applicative applicative
let { id } = category_Function
let (=<<) /* : (a -> m b) -> m a -> m b */ = flat_map
let (>>=) /* : m a -> (a -> m b) -> m b */ = flip flat_map
let join mm /* : m (m a) -> m a */ = mm >>= id
let forM_ xs f /* : List a -> (a -> m b) -> m () */ =
match xs with
| Cons y ys -> f y *> forM_ ys f
| Nil -> pure ()
{ applicative, flat_map, (=<<), (>>=), join, forM_ }
/// `Show a` represents a conversion function from `a` to a readable string.
type Show a = {
show : a -> String
}
let show_Unit : Show () = {
show = const "()"
}
let show_Bool : Show Bool = {
show = \x -> if x then "True" else "False"
}
let show_Int : Show Int = {
show = prim.show_Int
}
let show_Float : Show Float = {
show = prim.show_Float
}
let show_Char : Show Char = {
show = prim.show_Char
}
let (++) = string_prim.append
let show_Option : Show a -> Show (Option a) = \d ->
let show o =
match o with
| Some x -> "Some (" ++ d.show x ++ ")"
| None -> "None"
{ show }
let show_Result : Show e -> Show t -> Show (Result e t) = \e t ->
let show o =
match o with
| Ok x -> "Ok (" ++ t.show x ++ ")"
| Err x -> "Err (" ++ e.show x ++ ")"
{ show }
let monoid_List =
let append xs ys =
match xs with
| Cons x zs -> Cons x (append zs ys)
| Nil -> ys
{ append, empty = Nil }
let eq_List a : Eq a -> Eq (List a) =
let (==) l r =
match (l, r) with
| (Nil, Nil) -> True
| (Cons x xs, Cons y ys) -> a.(==) x y && xs == ys
| _ -> False
{ (==) }
let functor_List : Functor List =
let map f xs =
match xs with
| Cons y ys -> Cons (f y) (map f ys)
| Nil -> Nil
{ map }
let applicative_List : Applicative List =
let { (<>) } = make_Monoid monoid_List
let apply f xs =
match f with
| Cons g gs -> (functor_List.map g xs) <> (apply gs xs)
| Nil -> Nil
let pure x = Cons x Nil
{ functor = functor_List, apply, pure }
let alternative_List : Alternative List = {
applicative = applicative_List,
or = monoid_List.append,
empty = Nil
}
let monad_List : Monad List =
let { (<>) } = make_Monoid monoid_List
let flat_map f xs =
match xs with
| Cons x ys -> (f x) <> (flat_map f ys)
| Nil -> Nil
{ applicative = applicative_List, flat_map }
let show_List : Show a -> Show (List a) = \d ->
let show xs =
let show2 ys =
match ys with
| Cons y ys2 ->
match ys2 with
| Cons z zs -> d.show y ++ ", " ++ show2 ys2
| Nil -> d.show y ++ "]"
| Nil -> "]"
"[" ++ show2 xs
{ show }
let (==) = eq_Int.(==)
let (-) = num_Int.(-)
/// Constructs a list from an array. Useful to emulate list literals
///
/// ```
/// list [1, 2, 3]
/// ```
let list xs : Array a -> List a =
let len = array.length xs
let list_ i ys =
if i == 0 then
ys
else
let x = array.index xs (i - 1)
list_ (i - 1) (Cons x ys)
list_ len Nil
/// Folds a lift from the left
let foldl f x xs =
match xs with
| Cons y ys -> foldl f (f x y) ys
| Nil -> x
/// Folds a lift from the right
let foldr f x xs =
match xs with
| Cons y ys -> f y (foldr f x ys)
| Nil -> x
{
Bool,
Ordering,
Option,
Result,
List,
unwrap, unwrap_ok, unwrap_err,
not,
list, foldl, foldr,
Monoid, make_Monoid,
monoid_Function, monoid_List, monoid_Option,
monoid_Int_Add, monoid_Int_Mul, monoid_Float_Add, monoid_Float_Mul,
Eq,
eq_Unit, eq_Bool, eq_List, eq_Option, eq_Result, eq_Float, eq_Int, eq_Char,
Ord, make_Ord,
ord_Unit, ord_Bool, ord_Option, ord_Result, ord_Float, ord_Int, ord_Char,
Category, make_Category,
category_Function,
Functor,
functor_Option, functor_Result, functor_List, functor_IO,
Applicative, make_Applicative,
applicative_Option, applicative_Result, applicative_List, applicative_IO,
Alternative, make_Alternative,
alternative_Option, alternative_List,
Monad, make_Monad,
monad_Option, monad_List, monad_IO,
Num,
num_Int, num_Float,
id, const, flip, (<|), (|>), (<<), (>>),
Show,
show_Unit, show_Bool, show_Int, show_Float, show_Char, show_List, show_Option, show_Result
}