{-# LANGUAGE CPP #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeInType #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}
{-# OPTIONS_GHC -Wall #-}
{-# OPTIONS_GHC -Werror=incomplete-patterns #-}
{-|
Module : Fcf.Data.Char
Description : Type-level Char data methods
Copyright : (c) gspia 2020-
License : BSD
Maintainer : gspia
= Fcf.Data.Char
-}
--------------------------------------------------------------------------------
module Fcf.Data.Char
where
-- Version should be larger than 9.2.x. Note the two digit space for the
-- minor.
#if __GLASGOW_HASKELL__ >= 902
import qualified GHC.TypeLits as TL
import Fcf.Core (Eval, Exp)
import Fcf.Data.Bool (type (||))
import Fcf.Data.List (Elem)
import Fcf.Utils (TyEq)
--------------------------------------------------------------------------------
-- For the doctests:
-- $setup
--------------------------------------------------------------------------------
-- | IsSpace
--
-- === __Example__
--
-- >>> :kind! Eval (IsSpace 'a')
-- Eval (IsSpace 'a') :: Bool
-- = 'False
--
-- >>> :kind! Eval (IsSpace ' ')
-- Eval (IsSpace ' ') :: Bool
-- = 'True
data IsSpace :: Char -> Exp Bool
type instance Eval (IsSpace s) = Eval (s == ' ')
-- | IsNewline
--
-- === __Example__
--
-- >>> :kind! Eval (IsNewLine 'a')
-- Eval (IsNewLine 'a') :: Bool
-- = 'False
--
-- >>> :kind! Eval (IsNewLine '\n')
-- Eval (IsNewLine '\n') :: Bool
-- = 'True
data IsNewLine :: Char -> Exp Bool
type instance Eval (IsNewLine s) = Eval (s == '\n')
-- | IsTab
--
-- === __Example__
--
-- >>> :kind! Eval (IsTab 'a')
-- Eval (IsTab 'a') :: Bool
-- = 'False
--
-- >>> :kind! Eval (IsTab '\t')
-- Eval (IsTab '\t') :: Bool
-- = 'True
data IsTab :: Char -> Exp Bool
type instance Eval (IsTab s) = Eval (s == '\t')
-- | IsSpaceDelim
--
-- === __Example__
--
-- >>> :kind! Eval (IsSpaceDelim 'a')
-- Eval (IsSpaceDelim 'a') :: Bool
-- = 'False
--
-- >>> :kind! Eval (IsSpaceDelim '\n')
-- Eval (IsSpaceDelim '\n') :: Bool
-- = 'True
data IsSpaceDelim :: Char -> Exp Bool
type instance Eval (IsSpaceDelim s) =
Eval (Eval (IsSpace s) || Eval (Eval (IsNewLine s) || Eval (IsTab s)))
-- | IsDigit
--
-- === __Example__
--
-- >>> :kind! Eval (IsDigit '3')
-- Eval (IsDigit '3') :: Bool
-- = 'True
--
-- >>> :kind! Eval (IsDigit 'a')
-- Eval (IsDigit 'a') :: Bool
-- = 'False
data IsDigit :: Char -> Exp Bool
type instance Eval (IsDigit s)
= Eval (Elem s '[ '0','1','2','3','4','5','6','7','8','9'])
--------------------------------------------------------------------------------
-- | CharOrd - compare two symbols and give type-level Ordering
-- ( $ 'LT $, $ 'EQ $ or $ 'GT $ ).
--
-- === __Example__
--
-- >>> :kind! Eval (CharOrd 'a' 'b')
-- Eval (CharOrd 'a' 'b') :: Ordering
-- = 'LT
data CharOrd :: Char -> Char -> Exp Ordering
type instance Eval (CharOrd a b) = TL.CmpChar a b
-- | Less-than-or-equal comparison for symbols.
--
-- === __Example__
--
-- >>> :kind! Eval ('b' <= 'a')
-- Eval ('b' <= 'a') :: Bool
-- = 'False
--
data (<=) :: Char -> Char -> Exp Bool
type instance Eval ((<=) a b) =
Eval (Eval (TyEq (TL.CmpChar a b) 'LT) || Eval (TyEq (TL.CmpChar a b) 'EQ))
-- | Larger-than-or-equal comparison for symbols.
--
-- === __Example__
--
-- >>> :kind! Eval ('b' >= 'a')
-- Eval ('b' >= 'a') :: Bool
-- = 'True
data (>=) :: Char -> Char -> Exp Bool
type instance Eval ((>=) a b) =
Eval (Eval (TyEq (TL.CmpChar a b) 'GT) || Eval (TyEq (TL.CmpChar a b) 'EQ))
-- | Less-than comparison for symbols.
--
-- === __Example__
--
-- >>> :kind! Eval ('a' < 'b')
-- Eval ('a' < 'b') :: Bool
-- = 'True
data (<) :: Char -> Char -> Exp Bool
type instance Eval ((<) a b) = Eval (TyEq (TL.CmpChar a b) 'LT)
-- | Larger-than comparison for symbols.
--
-- === __Example__
--
-- >>> :kind! Eval ('b' > 'a')
-- Eval ('b' > 'a') :: Bool
-- = 'True
data (>) :: Char -> Char -> Exp Bool
type instance Eval ((>) a b) = Eval (TyEq (TL.CmpChar a b) 'GT)
-- | Equality of symbols
--
-- === __Example__
--
-- >>> :kind! Eval ('b' == 'a')
-- Eval ('b' == 'a') :: Bool
-- = 'False
data (==) :: Char -> Char -> Exp Bool
type instance Eval ((==) a b) = Eval (TyEq (TL.CmpChar a b) 'EQ)
--------------------------------------------------------------------------------
#else
--------------------------------------------------------------------------------
#endif
--------------------------------------------------------------------------------