Heimdell

module Union where

import Control.Monad
import qualified Control.Monad.Reader as MTL

data Union fs (m :: * -> *) x where
  Here  :: f m x -> Union (f : fs) m x
  There :: Union fs m x -> Union (f : fs) m x

Heimdell

module AST where

import Data.Constraint
import Data.Functor.Compose
import Data.Fix
import Data.Text (Text)
import qualified Data.Text as Text

import GHC.TypeLits

Heimdell

{-# language DataKinds              #-}
{-# language DerivingStrategies     #-}
{-# language DeriveFunctor          #-}
{-# language FlexibleContexts       #-}
{-# language FlexibleInstances      #-}
{-# language FunctionalDependencies #-}
{-# language GADTs                  #-}
{-# language KindSignatures         #-}
{-# language MultiParamTypeClasses  #-}
{-# language ScopedTypeVariables    #-}

Heimdell

module Weld where

import Control.Arrow

import Data.Bifunctor as B

import Text.PrettyPrint as PP hiding ((<>))

infix 1 \/

Heimdell

module Optics.Core exposing
  ( Optic
  , id
  , o
  
  , lens
  , prism
  , traversal

  , view

Heimdell

{-# language LambdaCase #-}
{-# language BlockArguments #-}
{-# language GADTs #-}
{-# language DataKinds #-}
{-# language TypeApplications #-}
{-# language DuplicateRecordFields #-}

{-|

Heimdell

module type FUNCTOR = sig
  type 'a t
  val map : ('a -> 'b) -> 'a t -> 'b t
end

module type APPLY = sig
  include FUNCTOR
  val ap : ('a -> 'b) t -> 'a t -> 'b t
end

Heimdell

{- | The union of functors and utilities.

-}

module Union
  ( -- * Union type
    Union(..)
  , eliminate

Heimdell

type ('r, 'a) logic = Logic of (('a -> 'r -> 'r) -> 'r -> 'r)

let runLogic : ('r, 'a) logic -> ('a -> 'r -> 'r) -> 'r -> 'r
  = fun (Logic run) -> run

let bind : ('r, 'a) logic -> ('a -> ('r, 'b) logic) -> ('r, 'b) logic
  = fun (Logic ma) amb ->
    Logic <| fun yes no ->
      ma (fun a -> runLogic (amb a) yes) no

Heimdell

module Example

type fs =
  | File of string list
  | Dir  of (string, fs) Map

type fsKind =
  | IsFile
  | IsDir