src/Symantic/Compta/Lang/Rebindable.hs

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