{-# LANGUAGE Trustworthy #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE TypeFamilies #-}
module GHC.IsList
( IsList(..)
) where
import GHC.Base
import GHC.Stack
import Data.Version ( Version(..), makeVersion )
import Control.Applicative (ZipList(..))
class IsList l where
type Item l
fromList :: [Item l] -> l
fromListN :: Int -> [Item l] -> l
fromListN Int
_ = [Item l] -> l
forall l. IsList l => [Item l] -> l
fromList
toList :: l -> [Item l]
instance IsList [a] where
type (Item [a]) = a
fromList :: [Item [a]] -> [a]
fromList = [a] -> [a]
[Item [a]] -> [a]
forall a. a -> a
id
toList :: [a] -> [Item [a]]
toList = [a] -> [a]
[a] -> [Item [a]]
forall a. a -> a
id
instance IsList (ZipList a) where
type Item (ZipList a) = a
fromList :: [Item (ZipList a)] -> ZipList a
fromList = [a] -> ZipList a
[Item (ZipList a)] -> ZipList a
forall a. [a] -> ZipList a
ZipList
toList :: ZipList a -> [Item (ZipList a)]
toList = ZipList a -> [a]
ZipList a -> [Item (ZipList a)]
forall a. ZipList a -> [a]
getZipList
instance IsList (NonEmpty a) where
type Item (NonEmpty a) = a
fromList :: [Item (NonEmpty a)] -> NonEmpty a
fromList (Item (NonEmpty a)
a:[Item (NonEmpty a)]
as) = a
Item (NonEmpty a)
a a -> [a] -> NonEmpty a
forall a. a -> [a] -> NonEmpty a
:| [a]
[Item (NonEmpty a)]
as
fromList [] = [Char] -> NonEmpty a
forall a. [Char] -> a
errorWithoutStackTrace [Char]
"NonEmpty.fromList: empty list"
toList :: NonEmpty a -> [Item (NonEmpty a)]
toList ~(a
a :| [a]
as) = a
a a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
as
instance IsList Version where
type (Item Version) = Int
fromList :: [Item Version] -> Version
fromList = [Int] -> Version
[Item Version] -> Version
makeVersion
toList :: Version -> [Item Version]
toList = Version -> [Int]
Version -> [Item Version]
versionBranch
instance IsList CallStack where
type (Item CallStack) = (String, SrcLoc)
fromList :: [Item CallStack] -> CallStack
fromList = [([Char], SrcLoc)] -> CallStack
[Item CallStack] -> CallStack
fromCallSiteList
toList :: CallStack -> [Item CallStack]
toList = CallStack -> [([Char], SrcLoc)]
CallStack -> [Item CallStack]
getCallStack