├── .gitignore
├── README.md
├── bower.json
├── test
    └── Main.purs
└── src
    └── LeibnizProof.purs


/.gitignore:
--------------------------------------------------------------------------------
1 | /.*
2 | !/.gitignore
3 | !/.travis.yml
4 | /bower_components/
5 | /node_modules/
6 | /output/
7 | /tmp/
8 | 


--------------------------------------------------------------------------------
/README.md:
--------------------------------------------------------------------------------
1 | # purescript-leibniz-proof
2 | 
3 | Proof that the coercion functions in [`purescript-leibniz`](https://github.com/paf31/purescript-leibniz) can be implemented without any `unsafeCoerce` trickery.
4 | 
5 | - [The implementation](src/LeibnizProof.purs)
6 | - [An example usage](test/Main.purs)
7 | 


--------------------------------------------------------------------------------
/bower.json:
--------------------------------------------------------------------------------
 1 | {
 2 |   "private": true,
 3 |   "name": "purescript-leibniz-proof",
 4 |   "ignore": [
 5 |     "**/.*",
 6 |     "node_modules",
 7 |     "bower_components",
 8 |     "output"
 9 |   ],
10 |   "dependencies": {
11 |     "purescript-console": "^1.0.0"
12 |   },
13 |   "devDependencies": {
14 |     "purescript-psci-support": "^1.0.0"
15 |   }
16 | }
17 | 


--------------------------------------------------------------------------------
/test/Main.purs:
--------------------------------------------------------------------------------
 1 | module Test.Main where
 2 | 
 3 | import Prelude
 4 | import Control.Monad.Eff (Eff)
 5 | import Control.Monad.Eff.Console (CONSOLE, logShow)
 6 | import LeibnizProof (type (~), symm, coerce, refl)
 7 | 
 8 | data Test a
 9 |   = I Int (a ~ Int)
10 |   | B Boolean (a ~ Boolean)
11 | 
12 | int :: Int -> Test Int
13 | int i = I i refl
14 | 
15 | bool :: Boolean -> Test Boolean
16 | bool b = B b refl
17 | 
18 | eval :: forall a. Test a -> a
19 | eval (I value proof) = coerce (symm proof) value
20 | eval (B value proof) = coerce (symm proof) value
21 | 
22 | main :: forall e. Eff (console :: CONSOLE | e) Unit
23 | main = do
24 |   logShow $ eval $ int 5
25 |   logShow $ eval $ bool true
26 | 


--------------------------------------------------------------------------------
/src/LeibnizProof.purs:
--------------------------------------------------------------------------------
 1 | module LeibnizProof where
 2 | 
 3 | newtype Leibniz a b = Leibniz (forall f. f a -> f b)
 4 | 
 5 | infix 4 type Leibniz as ~
 6 | 
 7 | coe :: forall f a b. (a ~ b) -> f a -> f b
 8 | coe (Leibniz f) = f
 9 | 
10 | refl :: forall a. (a ~ a)
11 | refl = Leibniz (\x -> x)
12 | 
13 | -- no-cheating `coerce` implementation:
14 | 
15 | newtype Identity a = Identity a
16 | 
17 | unIdentity :: forall a. Identity a -> a
18 | unIdentity (Identity a) = a
19 | 
20 | coerce :: forall a b. (a ~ b) -> a -> b
21 | coerce p a = unIdentity (coe p (Identity a))
22 | 
23 | -- no-cheating `symm` implementation:
24 | 
25 | newtype Flip f a b = Flip (f b a)
26 | 
27 | unFlip :: forall f a b. Flip f a b -> f b a
28 | unFlip (Flip fba) = fba
29 | 
30 | symm :: forall a b. (a ~ b) -> (b ~ a)
31 | symm p = unFlip (coe p (Flip refl))
32 | 


--------------------------------------------------------------------------------