src/Literate/Rebindable.hs

   1 {-# LANGUAGE AllowAmbiguousTypes #-}
   2 {-# LANGUAGE BlockArguments #-}
   3 {-# LANGUAGE ConstraintKinds #-}
   4 {-# LANGUAGE DataKinds #-}
   5 {-# LANGUAGE DefaultSignatures #-}
   6 {-# LANGUAGE FlexibleContexts #-}
   7 {-# LANGUAGE GADTs #-}
   8 {-# LANGUAGE MultiParamTypeClasses #-}
   9 {-# LANGUAGE PostfixOperators #-}
  10 {-# LANGUAGE RebindableSyntax #-}
  11 {-# LANGUAGE TypeFamilies #-}
  12 {-# LANGUAGE UndecidableInstances #-}
  13 {-# LANGUAGE UnicodeSyntax #-}
  14 {-# LANGUAGE NoImplicitPrelude #-}
  15 {-# OPTIONS_GHC -Wno-missing-signatures #-}
  16 {-# OPTIONS_GHC -Wno-orphans #-}
  17 {-# OPTIONS_GHC -Wno-unused-do-bind #-}
  18 {-# OPTIONS_GHC -Wno-unused-imports #-}
  19
  20 module Literate.Rebindable (
  21   module Literate.Rebindable,
  22   IsList (..),
  23   IsString (..),
  24   Monad (..),
  25   MonadFail (..),
  26 ) where
  27
  28 import Control.Applicative (Applicative (..))
  29 import Control.Monad (Monad (..), MonadFail (..))
  30 import Data.Bool (Bool (..))
  31 import Data.Foldable (foldr)
  32 import Data.Function (id, ($), (.))
  33 import Data.Functor (Functor, (<$>))
  34 import Data.Int (Int)
  35 import Data.Kind
  36 import Data.List qualified as List
  37 import Data.Ratio (Ratio, Rational)
  38 import Data.Semigroup (Semigroup (..))
  39 import Data.String (String)
  40 import Data.String qualified as String
  41 import Data.Text (Text)
  42 import Data.Typeable
  43 import Data.Word (Word64)
  44 import GHC.Exts qualified as GHC
  45 import GHC.IsList (IsList (..))
  46 import GHC.Stack
  47 import GHC.TypeLits (ErrorMessage (..), Symbol)
  48 import Numeric.Natural (Natural)
  49 import Text.Show (Show (..))
  50 import Prelude (Double, Integer, Integral, error)
  51 import Prelude qualified
  52
  53 ifThenElse :: Bool -> a -> a -> a
  54 ifThenElse True x _ = x
  55 ifThenElse False _ y = y
  56
  57 -- * Class 'IsString'
  58
  59 -- | Like 'String.IsString' but with an 'HasCallStack' constraint
  60 --  to report the location of the 'String'.
  61 --  This is to be used with the @OverloadedStrings@ and @RebindableSyntax@ extensions
  62 --  to replace literal strings by this 'fromString'.
  63 class IsString a where
  64   fromString :: HasCallStack => String -> a
  65   default fromString ::
  66     String.IsString a =>
  67     HasCallStack =>
  68     String ->
  69     a
  70   fromString = String.fromString
  71
  72 instance IsString String
  73 instance IsString Text
  74
  75 -- * Class 'FromInteger'
  76 class FromInteger a where
  77   fromInteger :: HasCallStack => Prelude.Integer -> a
  78   default fromInteger :: Prelude.Num a => Prelude.Integer -> a
  79   fromInteger = Prelude.fromInteger
  80 instance FromInteger (Ratio Natural)
  81 instance FromInteger Double
  82 instance FromInteger Int
  83 instance FromInteger Integer
  84 instance FromInteger Natural
  85 instance FromInteger Rational
  86 instance FromInteger Word64
  87
  88 -- instance FromInteger Decimal
  89
  90 -- * Class 'FromRational'
  91 class FromRational a where
  92   fromRational :: HasCallStack => Prelude.Rational -> a
  93   default fromRational :: Prelude.Fractional a => Prelude.Rational -> a
  94   fromRational = Prelude.fromRational
  95
  96 -- instance FromRational Decimal
  97 instance FromRational Double
  98 instance Integral a => FromRational (Ratio a)
  99
 100 -- * Class 'IsList'
 101
 102 {-
 103 class IsList a where
 104   type Item a :: Type
 105   type Item a = GHC.Item a
 106   fromList :: HasCallStack => [Item a] -> a
 107   fromListN :: HasCallStack => Prelude.Int -> [Item a] -> a
 108   toList :: HasCallStack => a -> [Item a]
 109   default fromList  :: GHC.Item a ~ Item a => GHC.IsList a => [Item a] -> a
 110   default fromListN :: GHC.Item a ~ Item a => GHC.IsList a => Prelude.Int -> [Item a] -> a
 111   default toList :: GHC.Item a ~ Item a => GHC.IsList a => a -> [Item a]
 112   fromList = GHC.fromList
 113   fromListN = GHC.fromListN
 114   toList = GHC.toList
 115 instance IsList [a]
 116 -}
 117 -- class Listable repr where
 118 --   cons :: repr a -> repr [a] -> repr [a]
 119 --   nil :: repr [a]
 120 --   concat :: repr [a] -> repr [a] -> repr [a]
 121 -- class IsList repr where
 122 --   fromList :: HasCallStack => [repr a] -> repr [a]
 123 --   fromListN :: HasCallStack => Int -> [repr a] -> repr [a]
 124
 125 -- toList :: HasCallStack => repr [a] -> [repr a]
 126 {-
 127 default fromList  :: GHC.Item a ~ Item a => GHC.IsList a => [Item a] -> a
 128 default fromListN :: GHC.Item a ~ Item a => GHC.IsList a => Prelude.Int -> [Item a] -> a
 129 default toList :: GHC.Item a ~ Item a => GHC.IsList a => a -> [Item a]
 130 fromList = GHC.fromList
 131 fromListN = GHC.fromListN
 132 toList = GHC.toList
 133 -}
 134 -- instance Listable repr => IsList repr where
 135 --   fromList = foldr cons nil
 136 --   fromListN _n = foldr cons nil
 137
 138 -- toList = error "toList"
 139
 140 {-
 141 class Applicative repr where
 142   fmap :: (a->b) -> repr a -> repr b
 143   pure :: a -> repr a
 144   (<*>) :: repr (a->b) -> repr a -> repr b
 145   join :: repr (repr a) -> repr a
 146 -}