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