1module Data.NonEmptyList 2 ( List(..) 3 , singleton 4 , toList 5 , sortBy 6 ) 7 where 8 9 10import Control.Monad (liftM2) 11import Data.Binary (Binary, get, put) 12import qualified Data.List as List 13 14 15 16-- LIST 17 18 19data List a = 20 List a [a] 21 22 23singleton :: a -> List a 24singleton a = 25 List a [] 26 27 28toList :: List a -> [a] 29toList (List x xs) = 30 x:xs 31 32 33 34-- INSTANCES 35 36 37instance Functor List where 38 fmap func (List x xs) = List (func x) (map func xs) 39 40 41instance Traversable List where 42 traverse func (List x xs) = List <$> func x <*> traverse func xs 43 44 45instance Foldable List where 46 foldr step state (List x xs) = step x (foldr step state xs) 47 foldl step state (List x xs) = foldl step (step state x) xs 48 foldl1 step (List x xs) = foldl step x xs 49 50 51 52-- SORT BY 53 54 55sortBy :: (Ord b) => (a -> b) -> List a -> List a 56sortBy toRank (List x xs) = 57 let 58 comparison a b = 59 compare (toRank a) (toRank b) 60 in 61 case List.sortBy comparison xs of 62 [] -> 63 List x [] 64 65 y:ys -> 66 case comparison x y of 67 LT -> List x (y:ys) 68 EQ -> List x (y:ys) 69 GT -> List y (List.insertBy comparison x ys) 70 71 72 73-- BINARY 74 75 76instance (Binary a) => Binary (List a) where 77 put (List x xs) = put x >> put xs 78 get = liftM2 List get get 79