1 {-# LANGUAGE FieldSelectors #-}
2 {-# LANGUAGE PackageImports #-}
3 {-# LANGUAGE UndecidableInstances #-}
4 {-# LANGUAGE NoMonomorphismRestriction #-}
5 {-# OPTIONS_GHC -Wno-orphans #-}
109 -- GenericProduct (..),
124 import Control.Applicative (Applicative (..))
125 import Control.Arrow (first, second, (>>>))
126 import Control.Monad (Monad (..), forM, forM_, unless, void, when)
127 import Data.Bool (Bool (..), not, otherwise, (&&), (||))
128 import Data.Char (Char)
129 import Data.Either (Either (..), either)
130 import Data.Eq (Eq (..))
131 import Data.Foldable (Foldable, all, and, any, fold, foldMap, foldr, maximum, minimum, null, or)
132 import Data.Function (const, flip, id, on, ($), (&), (.))
133 import Data.Functor (Functor (..), ($>), (<$), (<$>), (<&>))
134 import Data.Functor.Identity (Identity (..))
135 import Data.List ((++))
136 import Data.Map.Strict (Map)
137 import Data.Map.Strict qualified as Map
138 import Data.Maybe (Maybe (..), fromMaybe, isJust, isNothing, maybe, maybeToList)
139 import Data.Monoid (Ap (..), Last (..), Monoid (..))
140 import Data.Ord (Down (..), Ord (..))
141 import Data.Proxy (Proxy (..))
142 import Data.Semigroup (Max (..), Min (..), Semigroup (..), Sum (..))
143 import Data.Set (Set)
144 import Data.Set qualified as Set
145 import Data.String (IsString, String, fromString)
146 import Data.Text qualified as Text
147 import Data.Text.Short (ShortText)
148 import Data.Text.Short qualified as ShortText
149 import Data.Tuple (fst, snd)
150 import Debug.Pretty.Simple (pTrace, pTraceShow, pTraceShowId, pTraceShowM)
151 import GHC.Generics (Generic)
152 import GHC.IsList (IsList (..), toList)
153 import GHC.OverloadedLabels (IsLabel (..))
154 import GHC.Stack (HasCallStack)
155 import GHC.TypeLits (KnownNat (..), KnownSymbol (..), Symbol, natVal, symbolVal)
156 import System.IO (FilePath, IO)
158 -- import Generic.Data.Microsurgery (
161 -- GenericProduct (..),
172 import Numeric.Natural (Natural)
174 -- import Optics.Core
175 import Text.Pretty.Simple (pShow, pShowNoColor)
176 import Text.Show (Show (..))
177 import Type.Reflection (Typeable)
178 import "base" Prelude (Enum (..), Int, Integer, Num (..), Real (..), fromRational)
181 traceShow = pTraceShow
182 traceShowId = pTraceShowId
183 traceShowM = pTraceShowM
185 pattern (:=) :: a -> b -> (a, b)
186 pattern (:=) x y = (x, y)
189 class Assoc a b c where
191 instance Assoc a b (a, b) where
194 (<&) :: Functor f => a -> f b -> f a
195 (&>) :: Functor f => f b -> a -> f a
201 -- l <>~ n = over l (<> n)
202 -- {-# INLINE (<>~) #-}
204 instance IsList a => IsList (Last a) where
205 type Item (Last a) = Item a
206 fromList [] = Last Nothing
207 fromList xs = Last (Just (fromList xs))
208 toList (Last Nothing) = []
209 toList (Last (Just x)) = toList x
211 -- | Like `Last` but `mempty` is `[]` instead not `Nothing`.
212 -- Useful for deriving:
215 -- deriving Semigroup via (ProductSurgery (OnFields Lasts) Foo)
217 newtype Lasts a = Lasts a
218 deriving (Eq, Ord, Show, Generic)
220 instance Semigroup (Lasts [a]) where
224 instance (Monoid a, Semigroup (Lasts a)) => Monoid (Lasts a) where
225 mempty = Lasts mempty
227 newtype Newest a = Newest {unNewest :: a}
228 deriving (Eq, Ord, Generic)
229 deriving newtype (Show)
230 instance Semigroup (Newest a) where
233 newtype MapUnion k a = MapUnion {unMapUnion :: Map.Map k a}
234 deriving (Eq, Ord, Generic, Functor)
235 deriving newtype (Show)
237 -- CorrectionWarning: `Monoid` is not derived correctly via `Generically`,
238 -- it does not reuses `(<>)`.
239 -- See https://github.com/haskell/core-libraries-committee/issues/324
240 -- deriving (Monoid) via (Generically (MapUnion k a))
241 instance (Ord k, Semigroup a) => Semigroup (MapUnion k a) where
242 MapUnion x <> MapUnion y = MapUnion (Map.unionWith (<>) x y)
243 instance (Ord k, Semigroup a) => Monoid (MapUnion k a) where
244 mempty = MapUnion mempty
246 forMap :: (Foldable t, Monoid m) => t a -> (a -> m) -> m
247 forMap = flip foldMap
249 class DropPrefix a where
250 dropPrefix :: a -> a -> a
251 instance DropPrefix Text.Text where
252 dropPrefix p t = t & Text.stripPrefix p & fromMaybe t
253 instance DropPrefix ShortText where
254 dropPrefix p t = t & ShortText.stripPrefix p & fromMaybe t
256 setSingle = Set.singleton
257 {-# INLINE setSingle #-}
258 setInsert = Set.insert
259 {-# INLINE setInsert #-}
261 {-# INLINE setSize #-}
263 {-# INLINE mapSize #-}
264 mapLookup = Map.lookup
265 {-# INLINE mapLookup #-}
267 foldMapM :: (Applicative m, Foldable t, Monoid b) => (a -> m b) -> t a -> m b
268 foldMapM f = getAp <$> foldMap (Ap . f)