-- BNFC 3 -- (C) 2021 Andreas Abel {-# LANGUAGE TypeFamilies #-} -- for instance IsList -- | Lists of length at least 2. -- -- Import as: -- @ -- import BNFC.Utils.List2 (List2(List2)) -- import qualified BNFC.Utils.List2 as List2 -- @ module BNFC.Utils.List2 ( module BNFC.Utils.List2 , module Reexport ) where import Prelude ( Eq, Ord, Show, Functor, Foldable, Traversable , (.), ($), (++) , Bool , seq , undefined ) import Control.DeepSeq import qualified Data.List as List import qualified Data.List.NonEmpty as List1 import Data.List.NonEmpty ( pattern (:|) ) import Data.Semigroup ( Semigroup(..) ) import GHC.Exts ( IsList(..) ) import qualified GHC.Exts as Reexport ( toList ) type List1 = List1.NonEmpty -- | Lists of length ≥2. data List2 a = List2 a a [a] deriving (Eq, Ord, Show, Functor, Foldable, Traversable) instance Semigroup (List2 a) where List2 a1 a2 as <> bs = List2 a1 a2 $ as <> toList bs cons :: a -> List2 a -> List2 a cons a0 (List2 a1 a2 as) = List2 a0 a1 (a2 : as) snoc :: List2 a -> a -> List2 a snoc (List2 a1 a2 as) b = List2 a1 a2 (as ++ [b]) -- | Safe. head :: List2 a -> a head (List2 a _ _) = a -- | Safe. tail :: List2 a -> [a] tail (List2 _ b cs) = b : cs -- | Safe. tail1 :: List2 a -> List1 a tail1 (List2 _ b cs) = b :| cs instance IsList (List2 a) where type Item (List2 a) = a -- | Unsafe! fromList :: [a] -> List2 a fromList (a : b : cs) = List2 a b cs fromList _ = undefined toList :: List2 a -> [a] toList (List2 a b cs) = a : b : cs toList1 :: List2 a -> List1 a toList1 (List2 a b cs) = a :| b : cs -- | Unsafe! fromList :: [a] -> List2 a fromList (a : b : cs) = List2 a b cs fromList _ = undefined -- | Unsafe! fromList1 :: List1 a -> List2 a fromList1 (a :| b : cs) = List2 a b cs fromList1 _ = undefined break :: (a -> Bool) -> List2 a -> ([a],[a]) break p = List.break p . toList -- Foldable.elem -- elem :: Eq a => a -> List2 a -> Bool -- elem a (List b1 b2 bs) = a == b1 || a == b2 || a `List.elem` bs instance NFData a => NFData (List2 a) where rnf (List2 a b cs) = rnf a `seq` rnf b `seq` rnf cs