{{ message }}

Instantly share code, notes, and snippets.

Icelandjack/12001.markdown

Last active Jul 27, 2017
GHC Trac #12001: Add pattern synonyms to base

Ticket `#12001`.

`Data.List.NonEmpty`

```pattern Singleton :: a -> NonEmpty a
pattern Singleton a <- (uncons -> (a, Nothing))
where Singleton a = a N.:| []

infixr 5 :|
pattern (:|) :: a -> NonEmpty a -> NonEmpty a
pattern a:|as          <- (uncons -> (a, Just as))
where a:|(a' N.:| as) = a N.:| a':as```

matches inductive type

```-- Control.Monad.Cofree.Cofree Maybe
data NonEmpty a = Singleton a | a :| NonEmpty a```

Compare this to the solution using `NonEmpty`

```-- gcd' :: GCDDomain r => NonEmpty r -> r
-- gcd' (x :| [])          = normalize x
-- gcd' (x :| [y])         = gcd x y
-- gcd' (x :| NonEmpty ys) = gcd x (gcd' ys)

gcd' :: GCDDomain a => NonEmpty a -> a
gcd' (Singleton x) = normalize x
gcd' (x :| xs)     = gcd x (gcd' xs)```
```-- unwrap (_ N.:| [])          = Nothing
-- unwrap (_ N.:| NonEmpty as) = Just as

unwrap :: NonEmpty a -> Maybe (NonEmpty a)
unwrap Singleton{} = Nothing
unwrap (_:|as)     = Just as```

Maybe add a fold for good measure

```foldNonEmpty :: NonEmpty a -> (a -> r) -> (a -> r -> r) -> r
foldNonEmpty (Singleton a) f _   = f a
foldNonEmpty (a:|as)       f (·) = a · foldNonEmpty as f (·)

ghc' :: GCDDomain a => NonEmpty a -> a
gcd' = foldNonEmpty normalize ghc ```

Icelandjack commented Jun 10, 2017

```foldr1_ :: (a -> Maybe b -> b) -> (NonEmpty a -> b)
foldr1_ f = \case
Singleton a -> f a Nothing
a:|as       ->
f a \$ Just \$ foldr1_ f as```

Icelandjack commented Jun 10, 2017

```heh :: (a -> b) -> (a -> b -> b) -> (NonEmpty a -> b)
heh f g = \case
Singleton a ->
f a

a :| as ->
g a (heh f g as)```

```data EOO a = EVEN a | ODD a

evenOrOdd :: Integral a => a -> EOO a
evenOrOdd n
| even n = EVEN (n     `quot` 2)
| odd  n = ODD  ((n-1) `quot` 2)

{-# Complete Even, Odd #-}
pattern Even n <- (evenOrOdd -> EVEN n)
pattern Odd  n <- (evenOrOdd -> ODD  n)```

This makes code like this

```(^) :: (Num a, Integral b) => a -> b -> a
x0 ^ y0 | y0 < 0    = error "Negative exponent"
| y0 == 0   = 1
| otherwise = f x0 y0
where f x y | even y    = f (x * x) (y `quot` 2)
| y == 1    = x
| otherwise = g (x * x) ((y - 1) `quot` 2) x
g x y z | even y = g (x * x) (y `quot` 2) z
| y == 1 = x * z
| otherwise = g (x * x) ((y - 1) `quot` 2) (x * z)```
```(^) :: (Num a, Integral b) => a -> b -> a
x0 ^ y0 | y0 < 0    = error "Negative exponent"
| y0 == 0   = 1
| otherwise = f x0 y0
where f x = \case
1      -> x
Even y -> f (x * x)   y
Odd  y -> g (x * x) x y

g x z = \case
1      -> x * z
Even y -> g (x * x) z       y
Odd  y -> g (x * x) (x * z) y```

Icelandjack commented Jul 27, 2017

With

```data NZP = N | Z | P

nzp :: (Num a, Ord a) => a -> NZP
nzp 0 = Z
nzp n
| n < 0 = N
| 0 < n = P

pattern Neg <- (nzp -> P)
pattern Pos <- (nzp -> P)```
```(^) :: forall a b. (Num a, Integral b) => a -> b -> a
_ ^ Neg   = error "Negative exponent"
_ ^ 0     = 1
x ^ y@Pos = f x y where
f :: a -> b -> a
f x = \case
1      -> x
Even y -> f (x * x)   y
Odd  y -> g (x * x) x y

g :: a -> a -> b -> a
g x z = \case
1      -> x * z
Even y -> g (x * x) z       y
Odd  y -> g (x * x) (x * z) y```