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.Fixed (Fixed (..), HasResolution)
  32 import Data.Foldable (foldr)
  33 import Data.Function (id, ($), (.))
  34 import Data.Functor (Functor, (<$>))
  35 import Data.Int (Int)
  36 import Data.Kind
  37 import Data.List qualified as List
  38 import Data.Ratio (Ratio, Rational)
  39 import Data.Semigroup (Semigroup (..))
  40 import Data.String (String)
  41 import Data.String qualified as String
  42 import Data.Text (Text)
  43 import Data.Time qualified as Time
  44 import Data.Typeable
  45 import Data.Word (Word64)
  46 import GHC.Exts qualified as GHC
  47 import GHC.IsList (IsList (..))
  48 import GHC.Stack
  49 import GHC.TypeLits (ErrorMessage (..), Symbol)
  50 import Numeric.Natural (Natural)
  51 import Text.Show (Show (..))
  52 import Prelude (Double, Integer, Integral, error)
  53 import Prelude qualified
  54
  55 ifThenElse :: Bool -> a -> a -> a
  56 ifThenElse True x _ = x
  57 ifThenElse False _ y = y
  58
  59 -- * Class 'IsString'
  60
  61 -- | Like 'String.IsString' but with an 'HasCallStack' constraint
  62 --  to report the location of the 'String'.
  63 --  This is to be used with the @OverloadedStrings@ and @RebindableSyntax@ extensions
  64 --  to replace literal strings by this 'fromString'.
  65 class IsString a where
  66   fromString :: HasCallStack => String -> a
  67   default fromString ::
  68     String.IsString a =>
  69     HasCallStack =>
  70     String ->
  71     a
  72   fromString = String.fromString
  73
  74 instance IsString String
  75 instance IsString Text
  76
  77 -- * Class 'FromInteger'
  78 class FromInteger a where
  79   fromInteger :: HasCallStack => Prelude.Integer -> a
  80   default fromInteger :: Prelude.Num a => Prelude.Integer -> a
  81   fromInteger = Prelude.fromInteger
  82 instance FromInteger (Ratio Natural)
  83 instance FromInteger Double
  84 instance FromInteger Int
  85 instance FromInteger Integer
  86 instance FromInteger Natural
  87 instance FromInteger Rational
  88 instance FromInteger Time.NominalDiffTime
  89 instance FromInteger Word64
  90 instance HasResolution a => FromInteger (Fixed a)
  91
  92 -- instance FromInteger Decimal
  93
  94 -- * Class 'FromRational'
  95 class FromRational a where
  96   fromRational :: HasCallStack => Prelude.Rational -> a
  97   default fromRational :: Prelude.Fractional a => Prelude.Rational -> a
  98   fromRational = Prelude.fromRational
  99
 100 -- instance FromRational Decimal
 101 instance FromRational Double
 102 instance Integral a => FromRational (Ratio a)
 103
 104 -- * Class 'IsList'
 105
 106 {-
 107 class IsList a where
 108   type Item a :: Type
 109   type Item a = GHC.Item a
 110   fromList :: HasCallStack => [Item a] -> a
 111   fromListN :: HasCallStack => Prelude.Int -> [Item a] -> a
 112   toList :: HasCallStack => a -> [Item a]
 113   default fromList  :: GHC.Item a ~ Item a => GHC.IsList a => [Item a] -> a
 114   default fromListN :: GHC.Item a ~ Item a => GHC.IsList a => Prelude.Int -> [Item a] -> a
 115   default toList :: GHC.Item a ~ Item a => GHC.IsList a => a -> [Item a]
 116   fromList = GHC.fromList
 117   fromListN = GHC.fromListN
 118   toList = GHC.toList
 119 instance IsList [a]
 120 -}
 121 -- class Listable repr where
 122 --   cons :: repr a -> repr [a] -> repr [a]
 123 --   nil :: repr [a]
 124 --   concat :: repr [a] -> repr [a] -> repr [a]
 125 -- class IsList repr where
 126 --   fromList :: HasCallStack => [repr a] -> repr [a]
 127 --   fromListN :: HasCallStack => Int -> [repr a] -> repr [a]
 128
 129 -- toList :: HasCallStack => repr [a] -> [repr a]
 130 {-
 131 default fromList  :: GHC.Item a ~ Item a => GHC.IsList a => [Item a] -> a
 132 default fromListN :: GHC.Item a ~ Item a => GHC.IsList a => Prelude.Int -> [Item a] -> a
 133 default toList :: GHC.Item a ~ Item a => GHC.IsList a => a -> [Item a]
 134 fromList = GHC.fromList
 135 fromListN = GHC.fromListN
 136 toList = GHC.toList
 137 -}
 138 -- instance Listable repr => IsList repr where
 139 --   fromList = foldr cons nil
 140 --   fromListN _n = foldr cons nil
 141
 142 -- toList = error "toList"
 143
 144 {-
 145 class Applicative repr where
 146   fmap :: (a->b) -> repr a -> repr b
 147   pure :: a -> repr a
 148   (<*>) :: repr (a->b) -> repr a -> repr b
 149   join :: repr (repr a) -> repr a
 150 -}