Skip to content

Instantly share code, notes, and snippets.

@MorrowM
Last active April 4, 2022 13:10
Show Gist options
  • Save MorrowM/ba41e2cc9ab57ef6df8c651452aa53c5 to your computer and use it in GitHub Desktop.
Save MorrowM/ba41e2cc9ab57ef6df8c651452aa53c5 to your computer and use it in GitHub Desktop.
Type-safe Partition
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE PatternSynonyms #-}
module Phantom where
import Data.List
newtype Part (bool :: Bool) a = Part { unPart :: [a] }
truePart :: Part True Int
truePart = Part [1, 2, 3, 4]
falsePart :: Part False Int
falsePart = Part [1, 2, 3, 4]
-- The following gives a type error!
-- parts = [truePart, falsePart]
pattern Trues :: [a] -> Part True a
pattern Trues xs = Part xs
{-# COMPLETE Trues #-}
pattern Falses :: [a] -> Part False a
pattern Falses xs = Part xs
{-# COMPLETE Falses #-}
instance Show a => Show (Part False a) where
showsPrec n (Falses xs) = showParen (n > 10) (showString "Falses " . shows xs)
instance Show a => Show (Part True a) where
showsPrec n (Trues xs) = showParen (n > 10) (showString "Trues " . shows xs)
partitionTyped :: (a -> Bool) -> [a] -> (Part True a, Part False a)
partitionTyped p xs =
let (trues, falses) = partition p xs
in (Part trues, Part falses)
greaterThan7sFirst :: [Int] -> [Int]
greaterThan7sFirst xs =
let (Trues greaterThans, Falses lessThans) = partitionTyped (> 7) xs
in greaterThans ++ lessThans
module TwoTypes where
import Data.List
newtype TruePart a = Trues [a]
deriving (Eq, Ord, Show, Read)
newtype FalsePart a = Falses [a]
deriving (Eq, Ord, Show, Read)
partitionTyped :: (a -> Bool) -> [a] -> (TruePart a, FalsePart a)
partitionTyped p xs =
let (trues, falses) = partition p xs
in (Trues trues, Falses falses)
-- | Moves the elements of a given list that are greater than 7 to the front.
greaterThan7sFirst :: [Int] -> [Int]
greaterThan7sFirst xs =
let (Trues greaterThans, Falses lessThans) = partitionTyped (> 7) xs
in greaterThans ++ lessThans
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment