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