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