Type-safe Partition

Phantom.hs

{-# 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

TwoTypes.hs

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