fcf-containers-0.3.0: Data structures and algorithms for first-class-families

Copyright(c) gspia 2020-
LicenseBSD
Maintainergspia
Safe HaskellSafe
LanguageHaskell2010

Fcf.Data.Text

Contents

Description

Fcf.Data.Text

We mimick Data.Text but on type level. The internal representation is based on type level lists.

Synopsis

Documentation

data Text Source #

Text is a data structure, that is, a list to hold type-level symbols of length one.

Constructors

Text [Symbol] 
Instances
type Eval Empty Source # 
Instance details

Defined in Fcf.Data.Text

type Eval Empty = Text ([] :: [Symbol])
type Eval (Unwords txts :: Text -> Type) Source # 
Instance details

Defined in Fcf.Data.Text

type Eval (Unwords txts :: Text -> Type) = Eval (Intercalate (Text (" " ': ([] :: [Symbol]))) txts)
type Eval (Unlines txts :: Text -> Type) Source # 
Instance details

Defined in Fcf.Data.Text

type Eval (Unlines txts :: Text -> Type) = Eval (Concat =<< Map (Flip Append (Singleton @@ "\n")) txts)
type Eval (Strip txt :: Text -> Type) Source # 
Instance details

Defined in Fcf.Data.Text

type Eval (Strip txt :: Text -> Type) = Eval (DropAround IsSpaceDelim txt)
type Eval (Concat lst :: Text -> Type) Source # 
Instance details

Defined in Fcf.Data.Text

type Eval (Concat lst :: Text -> Type) = Eval (Foldr Append (Eval Empty) lst)
type Eval (Reverse (Text lst) :: Text -> Type) Source # 
Instance details

Defined in Fcf.Data.Text

type Eval (Reverse (Text lst) :: Text -> Type) = Text (Eval (Reverse lst))
type Eval (FromList lst :: Text -> Type) Source # 
Instance details

Defined in Fcf.Data.Text

type Eval (FromList lst :: Text -> Type) = Text lst
type Eval (Singleton s :: Text -> Type) Source # 
Instance details

Defined in Fcf.Data.Text

type Eval (Singleton s :: Text -> Type) = Text (s ': ([] :: [Symbol]))
type Eval (DropAround f txt :: Text -> Type) Source # 
Instance details

Defined in Fcf.Data.Text

type Eval (DropAround f txt :: Text -> Type) = Eval (DropWhile f =<< DropWhileEnd f txt)
type Eval (DropWhileEnd f (Text lst) :: Text -> Type) Source # 
Instance details

Defined in Fcf.Data.Text

type Eval (DropWhileEnd f (Text lst) :: Text -> Type) = Text (Eval ((Reverse :: [Symbol] -> [Symbol] -> Type) =<< (DropWhile f =<< Reverse lst)))
type Eval (DropWhile f (Text lst) :: Text -> Type) Source # 
Instance details

Defined in Fcf.Data.Text

type Eval (DropWhile f (Text lst) :: Text -> Type) = Text (Eval (DropWhile f lst))
type Eval (TakeWhileEnd f (Text lst) :: Text -> Type) Source # 
Instance details

Defined in Fcf.Data.Text

type Eval (TakeWhileEnd f (Text lst) :: Text -> Type) = Text (Eval ((Reverse :: [Symbol] -> [Symbol] -> Type) =<< (TakeWhile f =<< Reverse lst)))
type Eval (TakeWhile f (Text lst) :: Text -> Type) Source # 
Instance details

Defined in Fcf.Data.Text

type Eval (TakeWhile f (Text lst) :: Text -> Type) = Text (Eval (TakeWhile f lst))
type Eval (DropEnd n (Text lst) :: Text -> Type) Source # 
Instance details

Defined in Fcf.Data.Text

type Eval (DropEnd n (Text lst) :: Text -> Type) = Text (Eval ((Reverse :: [Symbol] -> [Symbol] -> Type) =<< ((Drop n :: [Symbol] -> [Symbol] -> Type) =<< Reverse lst)))
type Eval (Drop n (Text lst) :: Text -> Type) Source # 
Instance details

Defined in Fcf.Data.Text

type Eval (Drop n (Text lst) :: Text -> Type) = Text (Eval (Drop n lst))
type Eval (TakeEnd n (Text lst) :: Text -> Type) Source # 
Instance details

Defined in Fcf.Data.Text

type Eval (TakeEnd n (Text lst) :: Text -> Type) = Text (Eval ((Reverse :: [Symbol] -> [Symbol] -> Type) =<< ((Take n :: [Symbol] -> [Symbol] -> Type) =<< Reverse lst)))
type Eval (Take n (Text lst) :: Text -> Type) Source # 
Instance details

Defined in Fcf.Data.Text

type Eval (Take n (Text lst) :: Text -> Type) = Text (Eval (Take n lst))
type Eval (ConcatMap f (Text lst) :: Text -> Type) Source # 
Instance details

Defined in Fcf.Data.Text

type Eval (ConcatMap f (Text lst) :: Text -> Type) = Eval (Concat =<< Map f lst)
type Eval (Intersperse s (Text txt) :: Text -> Type) Source # 
Instance details

Defined in Fcf.Data.Text

type Eval (Intersperse s (Text txt) :: Text -> Type) = Eval (FromList =<< Intersperse s txt)
type Eval (Intercalate (Text txt) txts :: Text -> Type) Source # 
Instance details

Defined in Fcf.Data.Text

type Eval (Intercalate (Text txt) txts :: Text -> Type) = Eval (FromList =<< (Intercalate txt =<< Map ToList txts))
type Eval (Map f (Text lst) :: Text -> Type) Source # 
Instance details

Defined in Fcf.Data.Text

type Eval (Map f (Text lst) :: Text -> Type) = Text (Eval (Map f lst))
type Eval (Append (Text l1) (Text l2) :: Text -> Type) Source # 
Instance details

Defined in Fcf.Data.Text

type Eval (Append (Text l1) (Text l2) :: Text -> Type) = Text (Eval (l1 ++ l2))
type Eval (Snoc (Text lst) s :: Text -> Type) Source # 
Instance details

Defined in Fcf.Data.Text

type Eval (Snoc (Text lst) s :: Text -> Type) = Text (Eval (lst ++ (s ': ([] :: [Symbol]))))
type Eval (Cons s (Text lst) :: Text -> Type) Source # 
Instance details

Defined in Fcf.Data.Text

type Eval (Cons s (Text lst) :: Text -> Type) = Text (s ': lst)
type Eval (Replace orig new txt :: Text -> Type) Source # 
Instance details

Defined in Fcf.Data.Text

type Eval (Replace orig new txt :: Text -> Type) = Eval (Intercalate new =<< SplitOn orig txt)
type Eval (Words txt :: [Text] -> Type) Source # 
Instance details

Defined in Fcf.Data.Text

type Eval (Words txt :: [Text] -> Type) = Eval (Split IsSpaceDelim txt)
type Eval (Lines txt :: [Text] -> Type) Source # 
Instance details

Defined in Fcf.Data.Text

type Eval (Lines txt :: [Text] -> Type) = Eval (Split IsNewLine txt)
type Eval (Unsnoc txt :: Maybe (Symbol, Text) -> Type) Source # 
Instance details

Defined in Fcf.Data.Text

type Eval (Unsnoc txt :: Maybe (Symbol, Text) -> Type) = Eval ((Map (Second Reverse :: (Symbol, Text) -> (Symbol, Text) -> Type) :: Maybe (Symbol, Text) -> Maybe (Symbol, Text) -> Type) =<< (Uncons =<< Reverse txt))
type Eval (Uncons (Text (t ': txt)) :: Maybe (Symbol, Text) -> Type) Source # 
Instance details

Defined in Fcf.Data.Text

type Eval (Uncons (Text (t ': txt)) :: Maybe (Symbol, Text) -> Type) = Just ((,) t (Text txt))
type Eval (Uncons (Text ([] :: [Symbol]))) Source # 
Instance details

Defined in Fcf.Data.Text

type Eval (Uncons (Text ([] :: [Symbol]))) = (Nothing :: Maybe (Symbol, Text))
type Eval (Init (Text lst) :: Maybe Text -> Type) Source # 
Instance details

Defined in Fcf.Data.Text

type Eval (Init (Text lst) :: Maybe Text -> Type) = Eval ((Map FromList :: Maybe [Symbol] -> Maybe Text -> Type) =<< Init lst)
type Eval (Tail (Text lst) :: Maybe Text -> Type) Source # 
Instance details

Defined in Fcf.Data.Text

type Eval (Tail (Text lst) :: Maybe Text -> Type) = Eval ((Map FromList :: Maybe [Symbol] -> Maybe Text -> Type) =<< Tail lst)
type Eval (Split p (Text txt) :: [Text] -> Type) Source # 
Instance details

Defined in Fcf.Data.Text

type Eval (Split p (Text txt) :: [Text] -> Type)
type Eval (SplitOn (Text sep) (Text txt) :: [Text] -> Type) Source # 
Instance details

Defined in Fcf.Data.Text

type Eval (SplitOn (Text sep) (Text txt) :: [Text] -> Type)

Creation

data Empty :: Exp Text Source #

Empty

Example

Expand
>>> :kind! (Eval Empty :: Text)
(Eval Empty :: Text) :: Text
= 'Text '[]

See also the other examples in this module.

Instances
type Eval Empty Source # 
Instance details

Defined in Fcf.Data.Text

type Eval Empty = Text ([] :: [Symbol])

data Singleton :: Symbol -> Exp Text Source #

Singleton

Example

Expand
>>> :kind! Eval (Singleton "a")
Eval (Singleton "a") :: Text
= 'Text '["a"]
Instances
type Eval (Singleton s :: Text -> Type) Source # 
Instance details

Defined in Fcf.Data.Text

type Eval (Singleton s :: Text -> Type) = Text (s ': ([] :: [Symbol]))

data FromList :: [Symbol] -> Exp Text Source #

Use FromList to construct a Text from type-level list.

Example

Expand

:kind! Eval (FromList '["h", "e", "l", "l", "u", "r", "e", "i"]) Eval (FromList '["h", "e", "l", "l", "u", "r", "e", "i"]) :: Text = 'Text '["h", "e", "l", "l", "u", "r", "e", "i"]

Instances
type Eval (FromList lst :: Text -> Type) Source # 
Instance details

Defined in Fcf.Data.Text

type Eval (FromList lst :: Text -> Type) = Text lst

data ToList :: Text -> Exp [Symbol] Source #

Get the type-level list out of the Text.

Example

Expand
>>> :kind! Eval (ToList =<< FromList '["a", "b"])
Eval (ToList =<< FromList '["a", "b"]) :: [Symbol]
= '["a", "b"]
Instances
type Eval (ToList (Text lst) :: [Symbol] -> Type) Source # 
Instance details

Defined in Fcf.Data.Text

type Eval (ToList (Text lst) :: [Symbol] -> Type) = lst

data ToSymbol :: Text -> Exp Symbol Source #

ToSymbol

Example

Expand
>>> :kind! Eval (ToSymbol =<< FromList '["w", "o", "r", "d"])
Eval (ToSymbol =<< FromList '["w", "o", "r", "d"]) :: Symbol
= "word"
Instances
type Eval (ToSymbol (Text lst) :: Symbol -> Type) Source # 
Instance details

Defined in Fcf.Data.Text

type Eval (ToSymbol (Text lst) :: Symbol -> Type) = Eval (Foldr Append "" lst)

Basic Interface

data Null :: Text -> Exp Bool Source #

Null

Example

Expand
>>> :kind! Eval (Null =<< FromList '["a", "b"])
Eval (Null =<< FromList '["a", "b"]) :: Bool
= 'False
>>> :kind! Eval (Null =<< Empty)
Eval (Null =<< Empty) :: Bool
= 'True
Instances
type Eval (Null (Text (_1 ': _2)) :: Bool -> Type) Source # 
Instance details

Defined in Fcf.Data.Text

type Eval (Null (Text (_1 ': _2)) :: Bool -> Type) = False
type Eval (Null (Text ([] :: [Symbol]))) Source # 
Instance details

Defined in Fcf.Data.Text

type Eval (Null (Text ([] :: [Symbol]))) = True

data Length :: Text -> Exp Nat Source #

Length

Example

Expand
>>> :kind! Eval (Length =<< FromList '["a", "b"])
Eval (Length =<< FromList '["a", "b"]) :: Nat
= 2
Instances
type Eval (Length (Text lst) :: Nat -> Type) Source # 
Instance details

Defined in Fcf.Data.Text

type Eval (Length (Text lst) :: Nat -> Type) = Eval (Length lst)

data Append :: Text -> Text -> Exp Text Source #

Append two type-level texts.

Example

Expand
>>> :kind! Eval (Append ('Text '["a", "a"]) ('Text '["m", "u"]))
Eval (Append ('Text '["a", "a"]) ('Text '["m", "u"])) :: Text
= 'Text '["a", "a", "m", "u"]
Instances
type Eval (Append (Text l1) (Text l2) :: Text -> Type) Source # 
Instance details

Defined in Fcf.Data.Text

type Eval (Append (Text l1) (Text l2) :: Text -> Type) = Text (Eval (l1 ++ l2))

data Cons :: Symbol -> Text -> Exp Text Source #

Add a symbol to the beginning of a type-level text.

Example

Expand
:kind! Eval (Cons "h" ('Text '["a", "a", "m", "u"]))

Eval (Cons "h" ('Text '["a", "a", "m", "u"])) :: Text = 'Text '["h", "a", "a", "m", "u"]

Instances
type Eval (Cons s (Text lst) :: Text -> Type) Source # 
Instance details

Defined in Fcf.Data.Text

type Eval (Cons s (Text lst) :: Text -> Type) = Text (s ': lst)

data Snoc :: Text -> Symbol -> Exp Text Source #

Add a symbol to the end of a type-level text.

Example

Expand
>>> :kind! Eval (Snoc ('Text '["a", "a", "m"]) "u")
Eval (Snoc ('Text '["a", "a", "m"]) "u") :: Text
= 'Text '["a", "a", "m", "u"]
Instances
type Eval (Snoc (Text lst) s :: Text -> Type) Source # 
Instance details

Defined in Fcf.Data.Text

type Eval (Snoc (Text lst) s :: Text -> Type) = Text (Eval (lst ++ (s ': ([] :: [Symbol]))))

data Uncons :: Text -> Exp (Maybe (Symbol, Text)) Source #

Get the first symbol from type-level text.

Example

Expand
>>> :kind! Eval (Uncons ('Text '["h", "a", "a", "m", "u"]))
Eval (Uncons ('Text '["h", "a", "a", "m", "u"])) :: Maybe
                                                      (Symbol, Text)
= 'Just '("h", 'Text '["a", "a", "m", "u"])
>>> :kind! Eval (Uncons ('Text '[]))
Eval (Uncons ('Text '[])) :: Maybe (Symbol, Text)
= 'Nothing
Instances
type Eval (Uncons (Text (t ': txt)) :: Maybe (Symbol, Text) -> Type) Source # 
Instance details

Defined in Fcf.Data.Text

type Eval (Uncons (Text (t ': txt)) :: Maybe (Symbol, Text) -> Type) = Just ((,) t (Text txt))
type Eval (Uncons (Text ([] :: [Symbol]))) Source # 
Instance details

Defined in Fcf.Data.Text

type Eval (Uncons (Text ([] :: [Symbol]))) = (Nothing :: Maybe (Symbol, Text))

data Unsnoc :: Text -> Exp (Maybe (Symbol, Text)) Source #

Get the last symbol from type-level text.

Example

Expand
>>> :kind! Eval (Unsnoc ('Text '["a", "a", "m", "u", "n"]))
Eval (Unsnoc ('Text '["a", "a", "m", "u", "n"])) :: Maybe
                                                      (Symbol, Text)
= 'Just '("n", 'Text '["a", "a", "m", "u"])
>>> :kind! Eval (Unsnoc ('Text '[]))
Eval (Unsnoc ('Text '[])) :: Maybe (Symbol, Text)
= 'Nothing
Instances
type Eval (Unsnoc txt :: Maybe (Symbol, Text) -> Type) Source # 
Instance details

Defined in Fcf.Data.Text

type Eval (Unsnoc txt :: Maybe (Symbol, Text) -> Type) = Eval ((Map (Second Reverse :: (Symbol, Text) -> (Symbol, Text) -> Type) :: Maybe (Symbol, Text) -> Maybe (Symbol, Text) -> Type) =<< (Uncons =<< Reverse txt))

data Head :: Text -> Exp (Maybe Symbol) Source #

Get the first symbol of type-level text.

Example

Expand
>>> :kind! Eval (Head ('Text '["a", "a", "m", "u"]))
Eval (Head ('Text '["a", "a", "m", "u"])) :: Maybe Symbol
= 'Just "a"
>>> :kind! Eval (Head ('Text '[]))
Eval (Head ('Text '[])) :: Maybe Symbol
= 'Nothing
Instances
type Eval (Head (Text lst) :: Maybe Symbol -> Type) Source # 
Instance details

Defined in Fcf.Data.Text

type Eval (Head (Text lst) :: Maybe Symbol -> Type) = Eval (Head lst)

data Tail :: Text -> Exp (Maybe Text) Source #

Get the tail of a type-level text.

Example

Expand
>>> :kind! Eval (Tail ('Text '["h", "a", "a", "m", "u"]))
Eval (Tail ('Text '["h", "a", "a", "m", "u"])) :: Maybe Text
= 'Just ('Text '["a", "a", "m", "u"])
>>> :kind! Eval (Tail ('Text '[]))
Eval (Tail ('Text '[])) :: Maybe Text
= 'Nothing
Instances
type Eval (Tail (Text lst) :: Maybe Text -> Type) Source # 
Instance details

Defined in Fcf.Data.Text

type Eval (Tail (Text lst) :: Maybe Text -> Type) = Eval ((Map FromList :: Maybe [Symbol] -> Maybe Text -> Type) =<< Tail lst)

data Init :: Text -> Exp (Maybe Text) Source #

Take all except the last symbol from type-level text.

Example

Expand
>>> :kind! Eval (Init ('Text '["a", "a", "m", "u", "n"]))
Eval (Init ('Text '["a", "a", "m", "u", "n"])) :: Maybe Text
= 'Just ('Text '["a", "a", "m", "u"])
>>> :kind! Eval (Init ('Text '[]))
Eval (Init ('Text '[])) :: Maybe Text
= 'Nothing
Instances
type Eval (Init (Text lst) :: Maybe Text -> Type) Source # 
Instance details

Defined in Fcf.Data.Text

type Eval (Init (Text lst) :: Maybe Text -> Type) = Eval ((Map FromList :: Maybe [Symbol] -> Maybe Text -> Type) =<< Init lst)

data CompareLength :: Text -> Nat -> Exp Ordering Source #

Compare the length of type-level text to given Nat and give the Ordering.

Example

Expand
>>> :kind! Eval (CompareLength ('Text '["a", "a", "m", "u"]) 3)
Eval (CompareLength ('Text '["a", "a", "m", "u"]) 3) :: Ordering
= 'GT
Instances
type Eval (CompareLength txt n :: Ordering -> Type) Source # 
Instance details

Defined in Fcf.Data.Text

type Eval (CompareLength txt n :: Ordering -> Type) = CmpNat (Length @@ txt) n

Transformation

data Map :: (Symbol -> Exp Symbol) -> Text -> Exp Text Source #

Map for type-level text.

Example

Expand
>>> :{
data IsIsymb :: Symbol -> Exp Bool
type instance Eval (IsIsymb s) = Eval ("i" S.== s)
data Isymb2e :: Symbol -> Exp Symbol
type instance Eval (Isymb2e s) = Eval
    (If (IsIsymb @@ s)
        (Pure "e")
        (Pure s)
    )
:}
>>> :kind! Eval (Map Isymb2e ('Text '["i","m","u"]))
Eval (Map Isymb2e ('Text '["i","m","u"])) :: Text
= 'Text '["e", "m", "u"]
Instances
type Eval (Map f (Text lst) :: Text -> Type) Source # 
Instance details

Defined in Fcf.Data.Text

type Eval (Map f (Text lst) :: Text -> Type) = Text (Eval (Map f lst))

data Intercalate :: Text -> [Text] -> Exp Text Source #

Intercalate for type-level text.

Example

Expand
>>> :kind! Eval (Intercalate ('Text '[" ", "&", " "]) ('[ 'Text '["a", "a", "m", "u"], 'Text '["v", "a", "l", "o"]]))
Eval (Intercalate ('Text '[" ", "&", " "]) ('[ 'Text '["a", "a", "m", "u"], 'Text '["v", "a", "l", "o"]])) :: Text
= 'Text '["a", "a", "m", "u", " ", "&", " ", "v", "a", "l", "o"]
Instances
type Eval (Intercalate (Text txt) txts :: Text -> Type) Source # 
Instance details

Defined in Fcf.Data.Text

type Eval (Intercalate (Text txt) txts :: Text -> Type) = Eval (FromList =<< (Intercalate txt =<< Map ToList txts))

data Intersperse :: Symbol -> Text -> Exp Text Source #

Intersperse for type-level text.

Example

Expand
>>> :kind! Eval (Intersperse "." ('Text '["a", "a", "m", "u"]))
Eval (Intersperse "." ('Text '["a", "a", "m", "u"])) :: Text
= 'Text '["a", ".", "a", ".", "m", ".", "u"]
Instances
type Eval (Intersperse s (Text txt) :: Text -> Type) Source # 
Instance details

Defined in Fcf.Data.Text

type Eval (Intersperse s (Text txt) :: Text -> Type) = Eval (FromList =<< Intersperse s txt)

data Reverse :: Text -> Exp Text Source #

Reverse for type-level text.

Example

Expand
>>> :kind! Eval (Reverse ('Text '["a", "a", "m", "u"]))
Eval (Reverse ('Text '["a", "a", "m", "u"])) :: Text
= 'Text '["u", "m", "a", "a"]
>>> :kind! Eval (Reverse =<< Reverse ('Text '["a", "a", "m", "u"]))
Eval (Reverse =<< Reverse ('Text '["a", "a", "m", "u"])) :: Text
= 'Text '["a", "a", "m", "u"]
Instances
type Eval (Reverse (Text lst) :: Text -> Type) Source # 
Instance details

Defined in Fcf.Data.Text

type Eval (Reverse (Text lst) :: Text -> Type) = Text (Eval (Reverse lst))

data Replace :: Text -> Text -> Text -> Exp Text Source #

Replace for type-level text.

Example

Expand
>>> :kind! Eval (Replace ('Text '["t","u"]) ('Text '["l","a"]) ('Text '["t","u","u","t","u","t","t","a","a"]))
Eval (Replace ('Text '["t","u"]) ('Text '["l","a"]) ('Text '["t","u","u","t","u","t","t","a","a"])) :: Text
= 'Text '["l", "a", "u", "l", "a", "t", "t", "a", "a"]
Instances
type Eval (Replace orig new txt :: Text -> Type) Source # 
Instance details

Defined in Fcf.Data.Text

type Eval (Replace orig new txt :: Text -> Type) = Eval (Intercalate new =<< SplitOn orig txt)

Special Folds

data Concat :: [Text] -> Exp Text Source #

Concat for type-level text.

Example

Expand
>>> :kind! Eval (Concat '[ 'Text '["l","a"], 'Text '["k","a","n","a"]])
Eval (Concat '[ 'Text '["l","a"], 'Text '["k","a","n","a"]]) :: Text
= 'Text '["l", "a", "k", "a", "n", "a"]
Instances
type Eval (Concat lst :: Text -> Type) Source # 
Instance details

Defined in Fcf.Data.Text

type Eval (Concat lst :: Text -> Type) = Eval (Foldr Append (Eval Empty) lst)

data ConcatMap :: (Symbol -> Exp Text) -> Text -> Exp Text Source #

ConcatMap for type-level text.

Example

Expand
>>> :{
data IsIsymb :: Symbol -> Exp Bool
type instance Eval (IsIsymb s) = Eval ("i" S.== s)
data Isymb2aa :: Symbol -> Exp Text
type instance Eval (Isymb2aa s) = Eval
    (If (IsIsymb @@ s)
        (Pure ('Text '["a","a"]))
        (Pure ('Text '[s]))
    )
:}
>>> :kind! Eval (ConcatMap Isymb2aa ('Text '["i","m","u"," ","i","h"]))
Eval (ConcatMap Isymb2aa ('Text '["i","m","u"," ","i","h"])) :: Text
= 'Text '["a", "a", "m", "u", " ", "a", "a", "h"]
Instances
type Eval (ConcatMap f (Text lst) :: Text -> Type) Source # 
Instance details

Defined in Fcf.Data.Text

type Eval (ConcatMap f (Text lst) :: Text -> Type) = Eval (Concat =<< Map f lst)

data Any :: (Symbol -> Exp Bool) -> Text -> Exp Bool Source #

Any for type-level text.

Example

Expand
>>> :kind! Eval (Any S.IsDigit ('Text '["a","a","m","u","1"]))
Eval (Any S.IsDigit ('Text '["a","a","m","u","1"])) :: Bool
= 'True
>>> :kind! Eval (Any S.IsDigit ('Text '["a","a","m","u"]))
Eval (Any S.IsDigit ('Text '["a","a","m","u"])) :: Bool
= 'False
Instances
type Eval (Any f (Text lst) :: Bool -> Type) Source # 
Instance details

Defined in Fcf.Data.Text

type Eval (Any f (Text lst) :: Bool -> Type) = Eval (Any f lst)

data All :: (Symbol -> Exp Bool) -> Text -> Exp Bool Source #

All for type-level text.

Example

Expand
>>> :kind! Eval (All S.IsDigit ('Text '["a","a","m","u","1"]))
Eval (All S.IsDigit ('Text '["a","a","m","u","1"])) :: Bool
= 'False
>>> :kind! Eval (All S.IsDigit ('Text '["3","2","1"]))
Eval (All S.IsDigit ('Text '["3","2","1"])) :: Bool
= 'True
Instances
type Eval (All f (Text lst) :: Bool -> Type) Source # 
Instance details

Defined in Fcf.Data.Text

type Eval (All f (Text lst) :: Bool -> Type) = Eval (All f lst)

Substrings

data Take :: Nat -> Text -> Exp Text Source #

Take for type-level text.

Example

Expand
>>> :kind! Eval (Take 4 ('Text '["a", "a", "m", "u", "n"]))
Eval (Take 4 ('Text '["a", "a", "m", "u", "n"])) :: Text
= 'Text '["a", "a", "m", "u"]
Instances
type Eval (Take n (Text lst) :: Text -> Type) Source # 
Instance details

Defined in Fcf.Data.Text

type Eval (Take n (Text lst) :: Text -> Type) = Text (Eval (Take n lst))

data TakeEnd :: Nat -> Text -> Exp Text Source #

TakeEnd for type-level text.

Example

Expand
>>> :kind! Eval (TakeEnd 4 ('Text '["h", "a", "a", "m", "u"]))
Eval (TakeEnd 4 ('Text '["h", "a", "a", "m", "u"])) :: Text
= 'Text '["a", "a", "m", "u"]
Instances
type Eval (TakeEnd n (Text lst) :: Text -> Type) Source # 
Instance details

Defined in Fcf.Data.Text

type Eval (TakeEnd n (Text lst) :: Text -> Type) = Text (Eval ((Reverse :: [Symbol] -> [Symbol] -> Type) =<< ((Take n :: [Symbol] -> [Symbol] -> Type) =<< Reverse lst)))

data Drop :: Nat -> Text -> Exp Text Source #

Drop for type-level text.

Example

Expand
>>> :kind! Eval (Drop 2 ('Text '["a", "a", "m", "u", "n", "a"]))
Eval (Drop 2 ('Text '["a", "a", "m", "u", "n", "a"])) :: Text
= 'Text '["m", "u", "n", "a"]
Instances
type Eval (Drop n (Text lst) :: Text -> Type) Source # 
Instance details

Defined in Fcf.Data.Text

type Eval (Drop n (Text lst) :: Text -> Type) = Text (Eval (Drop n lst))

data DropEnd :: Nat -> Text -> Exp Text Source #

DropEnd for type-level text.

Example

Expand
>>> :kind! Eval (DropEnd 2 ('Text '["a", "a", "m", "u", "n", "a"]))
Eval (DropEnd 2 ('Text '["a", "a", "m", "u", "n", "a"])) :: Text
= 'Text '["a", "a", "m", "u"]
Instances
type Eval (DropEnd n (Text lst) :: Text -> Type) Source # 
Instance details

Defined in Fcf.Data.Text

type Eval (DropEnd n (Text lst) :: Text -> Type) = Text (Eval ((Reverse :: [Symbol] -> [Symbol] -> Type) =<< ((Drop n :: [Symbol] -> [Symbol] -> Type) =<< Reverse lst)))

data TakeWhile :: (Symbol -> Exp Bool) -> Text -> Exp Text Source #

TakeWhile for type-level text.

Example

Expand
>>> :kind! Eval (TakeWhile (Not <=< S.IsDigit) ('Text '["a","a","m","u","1","2"]))
Eval (TakeWhile (Not <=< S.IsDigit) ('Text '["a","a","m","u","1","2"])) :: Text
= 'Text '["a", "a", "m", "u"]
Instances
type Eval (TakeWhile f (Text lst) :: Text -> Type) Source # 
Instance details

Defined in Fcf.Data.Text

type Eval (TakeWhile f (Text lst) :: Text -> Type) = Text (Eval (TakeWhile f lst))

data TakeWhileEnd :: (Symbol -> Exp Bool) -> Text -> Exp Text Source #

TakeWhileEnd for type-level text.

Example

Expand
>>> :kind! Eval (TakeWhileEnd (Not <=< S.IsDigit) ('Text '["1","2","a","a","m","u"]))
Eval (TakeWhileEnd (Not <=< S.IsDigit) ('Text '["1","2","a","a","m","u"])) :: Text
= 'Text '["a", "a", "m", "u"]
Instances
type Eval (TakeWhileEnd f (Text lst) :: Text -> Type) Source # 
Instance details

Defined in Fcf.Data.Text

type Eval (TakeWhileEnd f (Text lst) :: Text -> Type) = Text (Eval ((Reverse :: [Symbol] -> [Symbol] -> Type) =<< (TakeWhile f =<< Reverse lst)))

data DropWhile :: (Symbol -> Exp Bool) -> Text -> Exp Text Source #

DropWhile for type-level text.

Example

Expand
>>> :kind! Eval (DropWhile S.IsDigit ('Text '["1","2","a","a","m","u"]))
Eval (DropWhile S.IsDigit ('Text '["1","2","a","a","m","u"])) :: Text
= 'Text '["a", "a", "m", "u"]
Instances
type Eval (DropWhile f (Text lst) :: Text -> Type) Source # 
Instance details

Defined in Fcf.Data.Text

type Eval (DropWhile f (Text lst) :: Text -> Type) = Text (Eval (DropWhile f lst))

data DropWhileEnd :: (Symbol -> Exp Bool) -> Text -> Exp Text Source #

DropWhileEnd for type-level text. === Example

>>> :kind! Eval (DropWhileEnd S.IsDigit ('Text '["a","a","m","u","1","2"]))
Eval (DropWhileEnd S.IsDigit ('Text '["a","a","m","u","1","2"])) :: Text
= 'Text '["a", "a", "m", "u"]
Instances
type Eval (DropWhileEnd f (Text lst) :: Text -> Type) Source # 
Instance details

Defined in Fcf.Data.Text

type Eval (DropWhileEnd f (Text lst) :: Text -> Type) = Text (Eval ((Reverse :: [Symbol] -> [Symbol] -> Type) =<< (DropWhile f =<< Reverse lst)))

data DropAround :: (Symbol -> Exp Bool) -> Text -> Exp Text Source #

DropAround for type-level text.

Example

Expand
>>> :kind! Eval (DropAround S.IsDigit ('Text '["3","4","a","a","m","u","1","2"]))
Eval (DropAround S.IsDigit ('Text '["3","4","a","a","m","u","1","2"])) :: Text
= 'Text '["a", "a", "m", "u"]
Instances
type Eval (DropAround f txt :: Text -> Type) Source # 
Instance details

Defined in Fcf.Data.Text

type Eval (DropAround f txt :: Text -> Type) = Eval (DropWhile f =<< DropWhileEnd f txt)

data Strip :: Text -> Exp Text Source #

Strip the space, newline and tab -symbols from the beginning and and of type-level text.

Example

Expand
>>> :kind! Eval (Strip ('Text '[" ", " ", "a", "a", "m", "u", " ", "\n"]))
Eval (Strip ('Text '[" ", " ", "a", "a", "m", "u", " ", "\n"])) :: Text
= 'Text '["a", "a", "m", "u"]
Instances
type Eval (Strip txt :: Text -> Type) Source # 
Instance details

Defined in Fcf.Data.Text

type Eval (Strip txt :: Text -> Type) = Eval (DropAround IsSpaceDelim txt)

Breaking etc

data SplitOn :: Text -> Text -> Exp [Text] Source #

SplitOn for type-level text.

Example

Expand
>>> :kind! Eval (SplitOn (Eval (FromList '["a", "b"])) (Eval (FromList '[ "c", "d", "a", "b", "f", "g", "a", "b", "h"])))
Eval (SplitOn (Eval (FromList '["a", "b"])) (Eval (FromList '[ "c", "d", "a", "b", "f", "g", "a", "b", "h"]))) :: [Text]
= '[ 'Text '["c", "d"], 'Text '["f", "g"], 'Text '["h"]]
Instances
type Eval (SplitOn (Text sep) (Text txt) :: [Text] -> Type) Source # 
Instance details

Defined in Fcf.Data.Text

type Eval (SplitOn (Text sep) (Text txt) :: [Text] -> Type)

data Split :: (Symbol -> Exp Bool) -> Text -> Exp [Text] Source #

Split for type-level text.

Example

Expand
>>> :kind! Eval (Split S.IsSpace (Eval (FromList '[ "c", "d", " ", "b", "f", " ", "a", "b", "h"])))
Eval (Split S.IsSpace (Eval (FromList '[ "c", "d", " ", "b", "f", " ", "a", "b", "h"]))) :: [Text]
= '[ 'Text '["c", "d"], 'Text '["b", "f"], 'Text '["a", "b", "h"]]
Instances
type Eval (Split p (Text txt) :: [Text] -> Type) Source # 
Instance details

Defined in Fcf.Data.Text

type Eval (Split p (Text txt) :: [Text] -> Type)

data Lines :: Text -> Exp [Text] Source #

Lines for type-level text.

Example

Expand
>>> :kind! Eval (Lines =<< FromList '[ "o", "k", "\n", "h", "m", "m ", "\n", "a", "b"])
Eval (Lines =<< FromList '[ "o", "k", "\n", "h", "m", "m ", "\n", "a", "b"]) :: [Text]
= '[ 'Text '["o", "k"], 'Text '["h", "m", "m "], 'Text '["a", "b"]]
Instances
type Eval (Lines txt :: [Text] -> Type) Source # 
Instance details

Defined in Fcf.Data.Text

type Eval (Lines txt :: [Text] -> Type) = Eval (Split IsNewLine txt)

data Words :: Text -> Exp [Text] Source #

Words for type-level text.

Example

Expand
>>> :kind! Eval (Words =<< FromList '[ "o", "k", " ", "h", "m", "m ", "\n", "a", "b"])
Eval (Words =<< FromList '[ "o", "k", " ", "h", "m", "m ", "\n", "a", "b"]) :: [Text]
= '[ 'Text '["o", "k"], 'Text '["h", "m", "m "], 'Text '["a", "b"]]
Instances
type Eval (Words txt :: [Text] -> Type) Source # 
Instance details

Defined in Fcf.Data.Text

type Eval (Words txt :: [Text] -> Type) = Eval (Split IsSpaceDelim txt)

data Unlines :: [Text] -> Exp Text Source #

Unlines for type-level text. This adds a newline to each Text and then concats them.

Example

Expand
>>> :kind! Eval (Unlines '[ 'Text '["o", "k"], 'Text '["h", "m", "m "], 'Text '["a", "b"]])
Eval (Unlines '[ 'Text '["o", "k"], 'Text '["h", "m", "m "], 'Text '["a", "b"]]) :: Text
= 'Text '["o", "k", "\n", "h", "m", "m ", "\n", "a", "b", "\n"]
Instances
type Eval (Unlines txts :: Text -> Type) Source # 
Instance details

Defined in Fcf.Data.Text

type Eval (Unlines txts :: Text -> Type) = Eval (Concat =<< Map (Flip Append (Singleton @@ "\n")) txts)

data Unwords :: [Text] -> Exp Text Source #

Unwords for type-level text. This uses Intercalate to add space-symbol between the given texts.

Example

Expand
>>> :kind! Eval (Unwords '[ 'Text '["o", "k"], 'Text '["h", "m", "m "], 'Text '["a", "b"]])
Eval (Unwords '[ 'Text '["o", "k"], 'Text '["h", "m", "m "], 'Text '["a", "b"]]) :: Text
= 'Text '["o", "k", " ", "h", "m", "m ", " ", "a", "b"]
Instances
type Eval (Unwords txts :: Text -> Type) Source # 
Instance details

Defined in Fcf.Data.Text

type Eval (Unwords txts :: Text -> Type) = Eval (Intercalate (Text (" " ': ([] :: [Symbol]))) txts)

Predicates

data IsPrefixOf :: Text -> Text -> Exp Bool Source #

IsPrefixOf for type-level text.

Example

Expand
>>> :kind! Eval (IsPrefixOf ('Text '["a", "a"]) ('Text '["a", "a", "m", "i", "a", "i", "n", "e", "n"]))
Eval (IsPrefixOf ('Text '["a", "a"]) ('Text '["a", "a", "m", "i", "a", "i", "n", "e", "n"])) :: Bool
= 'True
Instances
type Eval (IsPrefixOf (Text l1) (Text l2) :: Bool -> Type) Source # 
Instance details

Defined in Fcf.Data.Text

type Eval (IsPrefixOf (Text l1) (Text l2) :: Bool -> Type) = Eval (IsPrefixOf l1 l2)

data IsSuffixOf :: Text -> Text -> Exp Bool Source #

IsSuffixOf for type-level text.

Example

Expand
>>> :kind! Eval (IsSuffixOf ('Text '["n", "e", "n"]) ('Text '["a", "a", "m", "i", "a", "i", "n", "e", "n"]))
Eval (IsSuffixOf ('Text '["n", "e", "n"]) ('Text '["a", "a", "m", "i", "a", "i", "n", "e", "n"])) :: Bool
= 'True
Instances
type Eval (IsSuffixOf (Text l1) (Text l2) :: Bool -> Type) Source # 
Instance details

Defined in Fcf.Data.Text

type Eval (IsSuffixOf (Text l1) (Text l2) :: Bool -> Type) = Eval (IsSuffixOf l1 l2)

data IsInfixOf :: Text -> Text -> Exp Bool Source #

IsInfixOf for type-level text.

Example

Expand
>>> :kind! Eval (IsInfixOf ('Text '["m", "i", "a"]) ('Text '["a", "a", "m", "i", "a", "i", "n", "e", "n"]))
Eval (IsInfixOf ('Text '["m", "i", "a"]) ('Text '["a", "a", "m", "i", "a", "i", "n", "e", "n"])) :: Bool
= 'True
Instances
type Eval (IsInfixOf (Text l1) (Text l2) :: Bool -> Type) Source # 
Instance details

Defined in Fcf.Data.Text

type Eval (IsInfixOf (Text l1) (Text l2) :: Bool -> Type) = Eval (IsInfixOf l1 l2)