Episode 28 type families and overlapping

episode028-type-families-overlapping/Flatten'.hs

@@ -0,0 +1,48 @@
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE UndecidableInstances #-}
+
+module Flatten' where
+
+import Data.Kind
+import Data.Proxy
+import Data.Foldable
+
+class Flatten a where
+  type Flattened a :: Type
+  flatten :: a -> Flattened a
+
+instance Flatten Bool where
+  type Flattened Bool = Bool
+  flatten x = x
+
+type family IsList (a :: Type) :: Bool where
+  IsList [a] = 'True
+  IsList _ = 'False
+
+instance Flatten' (IsList (Flattened a)) [a] => Flatten [a] where
+  type Flattened [a] = Flattened' (IsList (Flattened a)) [a]
+  flatten xs = flatten' (Proxy @(IsList (Flattened a))) xs
+
+class Flatten' (b :: Bool) a where
+  type Flattened' b a :: Type
+  flatten' :: Proxy b -> a -> Flattened' b a
+
+instance Flatten a => Flatten' False [a] where
+  type Flattened' False [a] = [Flattened a]
+  flatten' _ xs = map flatten xs
+
+instance (Flattened a ~ [b], Flatten a) => Flatten' True [a] where
+  type Flattened' True [a] = Flattened a
+  flatten' _ xs = concatMap flatten xs
+
+instance Flatten (Maybe a) where
+  type Flattened (Maybe a) = [a]
+  flatten Nothing = []
+  flatten (Just x) = [x]
+
+-- >>> flatten [[False, True],[True], [False, False]]
+-- [False,True,True,False,False]
+
+-- >>> flatten [Just False, Just True]
+-- [False,True]

episode028-type-families-overlapping/Flatten.hs

@@ -0,0 +1,50 @@
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE UndecidableInstances #-}
+
+module Flatten where
+
+import Data.Kind
+import Data.Proxy
+import Data.Foldable
+
+class Flatten a where
+  type Flattened a :: Type
+  flatten :: a -> Flattened a
+
+instance Flatten Bool where
+  type Flattened Bool = Bool
+  flatten x = x
+
+type family IsList (a :: Type) :: Bool where
+  IsList [a] = 'True
+  IsList _ = 'False
+
+instance Flatten' (IsList a) [a] => Flatten [a] where
+  type Flattened [a] = Flattened' (IsList a) [a]
+  flatten xs = flatten' (Proxy @(IsList a)) xs
+
+class Flatten' (b :: Bool) a where
+  type Flattened' b a :: Type
+  flatten' :: Proxy b -> a -> Flattened' b a
+
+instance Flatten a => Flatten' False [a] where
+  type Flattened' False [a] = [Flattened a]
+  flatten' _ xs = map flatten xs
+
+instance (Flattened [a] ~ [b], Flatten [a]) => Flatten' True [[a]] where
+  type Flattened' True [[a]] = Flattened [a]
+  flatten' _ xss = concatMap flatten xss
+
+{-
+instance Flatten a => Flatten [a] where
+  type Flattened [a] = [Flattened a]
+  flatten xs = map flatten xs
+
+instance Flatten a => Flatten [[a]] where
+  type Flattened [[a]] = [Flattened a]
+  flatten xss = concatMap flatten xss
+-}
+
+-- >>> flatten [[False, True],[True], [False, False]]
+-- [False,True,True,False,False]

episode028-type-families-overlapping/LICENSE

@@ -0,0 +1,30 @@
+Copyright (c) 2023, Well-Typed LLP
+
+All rights reserved.
+
+Redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions are met:
+
+    * Redistributions of source code must retain the above copyright
+      notice, this list of conditions and the following disclaimer.
+
+    * Redistributions in binary form must reproduce the above
+      copyright notice, this list of conditions and the following
+      disclaimer in the documentation and/or other materials provided
+      with the distribution.
+
+    * Neither the name of Well-Typed LLP nor the names of other
+      contributors may be used to endorse or promote products derived
+      from this software without specific prior written permission.
+
+THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

episode028-type-families-overlapping/Show'.hs

@@ -0,0 +1,41 @@
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE UndecidableInstances #-}
+
+module Show' where
+
+import Data.List
+import Data.Kind
+import Data.Proxy
+
+class MyShow a where
+  myshow :: a -> String
+
+instance MyShow Char where myshow = show
+instance MyShow Bool where myshow = show
+
+instance MyShow' (IsString [a]) [a] => MyShow [a] where
+  myshow = myshow' (Proxy @(IsString [a]))
+
+type family IsString (a :: Type) :: Bool where
+  IsString String = True
+  IsString _ = False
+
+class MyShow' (b :: Bool) a where
+  myshow' :: Proxy b -> a -> String
+
+instance MyShow a => MyShow' False [a] where
+  myshow' _ xs = "[" ++ intercalate "," (map myshow xs) ++ "]"
+
+-- instance MyShow' True String where
+instance a ~ Char => MyShow' True [a] where
+  myshow' _ xs = "\"" ++ xs ++ "\""
+
+
+example' :: MyShow [a] => [a] -> String
+example' xs = myshow (xs ++ xs)
+
+-- >>> myshow [False, True, False]
+-- "[False,True,False]"
+-- >>> example' "unfolder"
+-- "\"unfolderunfolder\""

episode028-type-families-overlapping/Show.hs

@@ -0,0 +1,26 @@
+{-# LANGUAGE UndecidableInstances #-}
+
+module Show where
+
+import Data.List
+import Data.Kind
+import Data.Proxy
+
+class MyShow a where
+  myshow :: a -> String
+
+instance MyShow Char where myshow = show
+instance MyShow Bool where myshow = show
+
+instance MyShow a => MyShow [a] where
+  myshow xs = "[" ++ intercalate "," (map myshow xs) ++ "]"
+
+instance {-# OVERLAPPING #-} MyShow String where
+  myshow xs = "\"" ++ xs ++ "\""
+
+example xs = myshow (xs ++ xs)
+
+-- >>> myshow [False, True, False]
+-- "[False,True,False]"
+-- >>> example "unfolder"
+-- "\"unfolderunfolder\""

episode028-type-families-overlapping/episode028-type-families-overlapping.cabal

@@ -0,0 +1,17 @@
+cabal-version: 3.0
+name:          episode028-unfoldr
+author:        Andres Löh <[email protected]>
+maintainer:    [email protected]
+version:       1
+build-type:    Simple
+license:       BSD-3-Clause
+license-file:  LICENSE
+
+library
+  default-language: GHC2021
+  build-depends:    base
+  exposed-modules:
+    Flatten
+    Flatten'
+    Show
+    Show'