{-# LANGUAGE CPP #-}

{-# OPTIONS_GHC -Wno-orphans #-}

-- | Non-empty lists.
--
--   Better name @List1@ for non-empty lists, plus missing functionality.
--
--   Import:
--   @
--
--     {-# LANGUAGE PatternSynonyms #-}
--
--     import           BNFC.Utils.List1 (List1, pattern (:|))
--     import qualified BNFC.Utils.List1 as List1
--
--   @

-- {-# OPTIONS_GHC -Wno-incomplete-patterns #-}
--   -- because of https://gitlab.haskell.org/ghc/ghc/issues/10339

module BNFC.Utils.List1
  ( module BNFC.Utils.List1
  , module List1
  ) where

import Prelude hiding (filter)

import           Control.Arrow      ( (&&&) )
import qualified Control.Monad      as List ( zipWithM, zipWithM_ )

import qualified Data.Either        as Either
import qualified Data.List          as List
import qualified Data.Maybe         as Maybe

import           Data.List.Extra    ( trim )
import           Data.String        ( IsString(..) )

import qualified Data.List.NonEmpty ( NonEmpty )
import           Data.List.NonEmpty as List1 hiding ( NonEmpty )

-- | Non-empty list.
-- TODO change to newtype?
type List1   = Data.List.NonEmpty.NonEmpty

-- | Non-empty 'String'.
type String1 = List1 Char

-- | Unsafe!
instance IsString String1 where
  fromString :: String -> String1
fromString = String -> String1
forall a. [a] -> NonEmpty a
fromList

trim1 :: String -> Maybe String1
trim1 :: String -> Maybe String1
trim1 = String -> Maybe String1
forall a. [a] -> Maybe (NonEmpty a)
List1.nonEmpty (String -> Maybe String1)
-> (String -> String) -> String -> Maybe String1
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
trim

-- | Return the last element and the rest.

initLast :: List1 a -> ([a], a)
initLast :: List1 a -> ([a], a)
initLast = List1 a -> [a]
forall a. NonEmpty a -> [a]
List1.init (List1 a -> [a]) -> (List1 a -> a) -> List1 a -> ([a], a)
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& List1 a -> a
forall a. NonEmpty a -> a
List1.last
  -- traverses twice, but does not create intermediate pairs

#if !MIN_VERSION_base(4,15,0)
-- | Build a list with one element.

singleton :: a -> List1 a
singleton :: a -> List1 a
singleton = (a -> [a] -> List1 a
forall a. a -> [a] -> NonEmpty a
:| [])
#endif

#if !MIN_VERSION_base(4,16,0)
-- | Append a list to a non-empty list.

appendList :: List1 a -> [a] -> List1 a
appendList :: List1 a -> [a] -> List1 a
appendList (a
x :| [a]
xs) [a]
ys = a
x a -> [a] -> List1 a
forall a. a -> [a] -> NonEmpty a
:| [a] -> [a] -> [a]
forall a. Monoid a => a -> a -> a
mappend [a]
xs [a]
ys

-- | Prepend a list to a non-empty list.

prependList :: [a] -> List1 a -> List1 a
prependList :: [a] -> List1 a -> List1 a
prependList [a]
as List1 a
bs = (a -> List1 a -> List1 a) -> List1 a -> [a] -> List1 a
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr a -> List1 a -> List1 a
forall a. a -> NonEmpty a -> NonEmpty a
(<|) List1 a
bs [a]
as
#endif

-- | More precise type for @snoc@.

snoc :: [a] -> a -> List1 a
snoc :: [a] -> a -> List1 a
snoc [a]
as a
a = [a] -> List1 a -> List1 a
forall a. [a] -> List1 a -> List1 a
prependList [a]
as (List1 a -> List1 a) -> List1 a -> List1 a
forall a b. (a -> b) -> a -> b
$ a
a a -> [a] -> List1 a
forall a. a -> [a] -> NonEmpty a
:| []

-- | Concatenate one or more non-empty lists.

concat :: [List1 a] -> [a]
concat :: [List1 a] -> [a]
concat = (List1 a -> [a]) -> [List1 a] -> [a]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap List1 a -> [a]
forall a. NonEmpty a -> [a]
toList

-- | Like 'Data.List.union'.  Duplicates in the first list are not removed.
-- O(nm).
union :: Eq a => List1 a -> List1 a -> List1 a
union :: List1 a -> List1 a -> List1 a
union (a
a :| [a]
as) List1 a
bs = a
a a -> [a] -> List1 a
forall a. a -> [a] -> NonEmpty a
:| [a] -> [a] -> [a]
forall a. Eq a => [a] -> [a] -> [a]
List.union [a]
as ((a -> Bool) -> List1 a -> [a]
forall a. (a -> Bool) -> NonEmpty a -> [a]
filter (a -> a -> Bool
forall a. Eq a => a -> a -> Bool
/= a
a) List1 a
bs)

-- * Recovering non-emptyness.

ifNull :: [a] -> b -> (List1 a -> b) -> b
ifNull :: [a] -> b -> (List1 a -> b) -> b
ifNull []       b
b List1 a -> b
_ = b
b
ifNull (a
a : [a]
as) b
_ List1 a -> b
f = List1 a -> b
f (List1 a -> b) -> List1 a -> b
forall a b. (a -> b) -> a -> b
$ a
a a -> [a] -> List1 a
forall a. a -> [a] -> NonEmpty a
:| [a]
as

ifNotNull :: [a] -> (List1 a -> b) -> b -> b
ifNotNull :: [a] -> (List1 a -> b) -> b -> b
ifNotNull []       List1 a -> b
_ b
b = b
b
ifNotNull (a
a : [a]
as) List1 a -> b
f b
_ = List1 a -> b
f (List1 a -> b) -> List1 a -> b
forall a b. (a -> b) -> a -> b
$ a
a a -> [a] -> List1 a
forall a. a -> [a] -> NonEmpty a
:| [a]
as

-- * List functions with no special behavior for non-empty lists.

-- | Checks if all the elements in the list are equal. Assumes that
--   the 'Eq' instance stands for an equivalence relation.
--   O(n).
allEqual :: Eq a => List1 a -> Bool
allEqual :: List1 a -> Bool
allEqual (a
x :| [a]
xs) = (a -> Bool) -> [a] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
x) [a]
xs

-- | Like 'Maybe.catMaybes'.

catMaybes :: List1 (Maybe a) -> [a]
catMaybes :: List1 (Maybe a) -> [a]
catMaybes =  [Maybe a] -> [a]
forall a. [Maybe a] -> [a]
Maybe.catMaybes ([Maybe a] -> [a])
-> (List1 (Maybe a) -> [Maybe a]) -> List1 (Maybe a) -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. List1 (Maybe a) -> [Maybe a]
forall a. NonEmpty a -> [a]
List1.toList

-- | Like 'List1.filter'.

mapMaybe :: (a -> Maybe b) -> List1 a -> [b]
mapMaybe :: (a -> Maybe b) -> List1 a -> [b]
mapMaybe a -> Maybe b
f = (a -> Maybe b) -> [a] -> [b]
forall a b. (a -> Maybe b) -> [a] -> [b]
Maybe.mapMaybe a -> Maybe b
f ([a] -> [b]) -> (List1 a -> [a]) -> List1 a -> [b]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. List1 a -> [a]
forall a. NonEmpty a -> [a]
List1.toList

-- | Like 'Data.Either.partitionEithers'.

partitionEithers :: List1 (Either a b) -> ([a], [b])
partitionEithers :: List1 (Either a b) -> ([a], [b])
partitionEithers = [Either a b] -> ([a], [b])
forall a b. [Either a b] -> ([a], [b])
Either.partitionEithers ([Either a b] -> ([a], [b]))
-> (List1 (Either a b) -> [Either a b])
-> List1 (Either a b)
-> ([a], [b])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. List1 (Either a b) -> [Either a b]
forall a. NonEmpty a -> [a]
List1.toList

-- | Like 'Data.Either.lefts'.

lefts :: List1 (Either a b) -> [a]
lefts :: List1 (Either a b) -> [a]
lefts = [Either a b] -> [a]
forall a b. [Either a b] -> [a]
Either.lefts  ([Either a b] -> [a])
-> (List1 (Either a b) -> [Either a b])
-> List1 (Either a b)
-> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. List1 (Either a b) -> [Either a b]
forall a. NonEmpty a -> [a]
List1.toList

-- | Like 'Data.Either.rights'.

rights :: List1 (Either a b) -> [b]
rights :: List1 (Either a b) -> [b]
rights = [Either a b] -> [b]
forall a b. [Either a b] -> [b]
Either.rights  ([Either a b] -> [b])
-> (List1 (Either a b) -> [Either a b])
-> List1 (Either a b)
-> [b]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. List1 (Either a b) -> [Either a b]
forall a. NonEmpty a -> [a]
List1.toList

-- | Like 'Control.Monad.zipWithM'.

zipWithM :: Applicative m => (a -> b -> m c) -> List1 a -> List1 b -> m (List1 c)
zipWithM :: (a -> b -> m c) -> List1 a -> List1 b -> m (List1 c)
zipWithM a -> b -> m c
f (a
a :| [a]
as) (b
b :| [b]
bs) = c -> [c] -> List1 c
forall a. a -> [a] -> NonEmpty a
(:|) (c -> [c] -> List1 c) -> m c -> m ([c] -> List1 c)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> b -> m c
f a
a b
b m ([c] -> List1 c) -> m [c] -> m (List1 c)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (a -> b -> m c) -> [a] -> [b] -> m [c]
forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> m c) -> [a] -> [b] -> m [c]
List.zipWithM a -> b -> m c
f [a]
as [b]
bs

-- | Like 'Control.Monad.zipWithM'.

zipWithM_ :: Applicative m => (a -> b -> m c) -> List1 a -> List1 b -> m ()
zipWithM_ :: (a -> b -> m c) -> List1 a -> List1 b -> m ()
zipWithM_ a -> b -> m c
f (a
a :| [a]
as) (b
b :| [b]
bs) = a -> b -> m c
f a
a b
b m c -> m () -> m ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (a -> b -> m c) -> [a] -> [b] -> m ()
forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> m c) -> [a] -> [b] -> m ()
List.zipWithM_ a -> b -> m c
f [a]
as [b]
bs