module Textual.SepList
(
SepList,
sepList,
slItems
) where
import Lawless
import Data.Textual
import Text.Printer (hsep)
import Data.Binary
import Data.List.NonEmpty
import Data.Foldable (Foldable)
import Data.Binary.Get
import Control.Monad.Fail
type SepList a = SepList' (NonEmpty a)
sepList ∷ ∀ a. (Ord a, Eq a, Binary a, Printable a) ⇒ a → SepList a
sepList a = SepList' $ a :| []
data SepList' a where
SepList' ∷ ∀ a. (Ord a, Eq a, Binary a, Printable a) ⇒ NonEmpty a → SepList' (NonEmpty a)
deriving instance Foldable SepList'
deriving instance Eq (SepList a)
deriving instance Ord (SepList a)
slItems ∷ Lens' (SepList' (NonEmpty a)) (NonEmpty a)
slItems = lens (\(SepList' i) → i) (\(SepList' _) j → SepList' j)
instance (Ord a) ⇒ Semigroup (SepList' (NonEmpty a)) where
a <> b = a & slItems .~ ((a ^. slItems) <> (b ^. slItems))
instance (Ord a, Binary a, Printable a) ⇒ Binary (SepList' (NonEmpty a)) where
put = putList ∘ toList ∘ view slItems
get = label "SepList'" $ do
(nonEmpty <$> get) >>= \case
Nothing → fail "Encountered an empty SepList'"
Just l → return ∘ SepList' $ l
instance (Printable a) ⇒ Printable (SepList' (NonEmpty a)) where
print = hsep ∘ over traversed print ∘ view slItems
instance (Printable a)⇒ Show (SepList a) where
show = toString