packages feed

fcf-containers 0.1.0 → 0.2.0

raw patch · 11 files changed

+533/−208 lines, 11 filesdep +fcf-containersdep ~basedep ~first-class-familiesPVP ok

version bump matches the API change (PVP)

Dependencies added: fcf-containers

Dependency ranges changed: base, first-class-families

API changes (from Hackage documentation)

- Fcf.Alg.List: data Concat :: [[a]] -> Exp [a]
- Fcf.Alg.List: data ConcatMap :: (a -> Exp [b]) -> [a] -> Exp [b]
- Fcf.Alg.List: data Elem :: a -> [a] -> Exp Bool
- Fcf.Alg.List: data Unfoldr :: (b -> Exp (Maybe (a, b))) -> b -> Exp [a]
- Fcf.Alg.List: data UnfoldrCase :: (b -> Exp (Maybe (a, b))) -> Maybe (a, b) -> Exp [a]
- Fcf.Data.MapC: data AdjustHelp :: (v -> Exp v) -> k -> [(k, v)] -> Exp [(k, v)]
- Fcf.Data.MapC: data DiffNotMem :: MapC k v -> k -> v -> Exp Bool
- Fcf.Data.MapC: data InsWithHelp :: (v -> v -> Exp v) -> k -> v -> (k, v) -> Exp (k, v)
- Fcf.Data.MapC: data InterMem :: MapC k v -> k -> v -> Exp Bool
- Fcf.Data.MapC: data MWKhelp :: [(k, v)] -> Exp [(k, (k, v))]
- Fcf.Data.MapC: data PartitionHlp :: ([(k, v)], [(k, v)]) -> Exp (MapC k v, MapC k v)
- Fcf.Data.MapC: data UComb :: (k, v) -> [(k, v)] -> Exp [(k, v)]
- Fcf.Data.Set: data DiffNotMem :: [v] -> v -> Exp Bool
- Fcf.Data.Set: data InterMem :: [v] -> v -> Exp Bool
- Fcf.Data.Set: data UComb :: v -> [v] -> Exp [v]
+ Fcf.Alg.List: data All :: [Bool] -> Exp Bool
+ Fcf.Alg.List: data Any :: [Bool] -> Exp Bool
+ Fcf.Data.Set: data PowerSet :: Set a -> Exp (Set (Set a))
+ Fcf.Data.Set: data ToList :: Set v -> Exp [v]
+ Fcf.Data.Symbol: data (==) :: Symbol -> Symbol -> Exp Bool
+ Fcf.Data.Symbol: data Append :: Symbol -> Symbol -> Exp Symbol
+ Fcf.Data.Symbol: data Intercalate :: Symbol -> [Symbol] -> Exp Symbol
+ Fcf.Data.Symbol: data Symbol

Files

CHANGELOG.md view
@@ -1,5 +1,16 @@ -# 0.1.0.0+# 0.2.0++ - remove the methods that can be found from fcf 0.7.0+ - fix the examples that didn't work with ghc 8.8.1 test-doc+ - add Fcf.Data.Symbol module (comparison + other functions)+ - change some of the examples from using Eval to use =<< operator+   (less parenthesis and easier to read this way)+ - format the documentation a bit+ - add PowerSet and ToList into Set-module+ - add new test module++# 0.1.0  Initial version on 20200129. The next version probably comes out quickly after  this one.
default.nix view
@@ -5,19 +5,29 @@   config = {     packageOverrides = pkgs: rec {       haskellPackages = pkgs.haskellPackages.override {+      # haskellPackages = pkgs.haskell.packages.${compiler}.override {         /* overrides = haskellPackagesNew: haskellPackagesOld: rec { */         overrides = self: super: rec {-          /* aeson = haskellPackagesNew.callPackage ./aeson.nix { }; */-          ghc = super.ghc  // { withPackages = super.ghc.withHoogle; };-          ghcWithPackages = self.ghc.withPackages;+          # ghc = super.ghc;+          # ghc = super.ghc  // { withPackages = super.ghc.withHoogle; };+          # ghcWithPackages = self.ghc.withPackages;+          # mkDerivation = args: super.mkDerivation (args // {+          #   enableLibraryProfiling = true;+          # });           first-class-families = self.callCabal2nix "first-class-families"            #   ~/gito/first-class-families {}; -            (pkgs.fetchFromGitHub { # 0.6+            (pkgs.fetchFromGitHub { # 0.7               owner  = "Lysxia";               repo   = "first-class-families";-              rev    = "2fb77468d3b0ce64dc5371bed1b636d60219975c";-              sha256 = "1jvn11nbb7271hhy7q21cyn4r238pfzj00aabd39gwhi0g2gzqbf";+              rev    = "120e41ea3831b9ffad62239e109c1b2a0aaf269f";+              sha256 = "0pyxpnkgr2rgn83whl37jh7k3rdr5hiprdmfkswwj7c1nhl1ky5i";             }) {};+            # (pkgs.fetchFromGitHub { # 0.6 TODO remove this+            #   owner  = "Lysxia";+            #   repo   = "first-class-families";+            #   rev    = "2fb77468d3b0ce64dc5371bed1b636d60219975c";+            #   sha256 = "1jvn11nbb7271hhy7q21cyn4r238pfzj00aabd39gwhi0g2gzqbf";+            # }) {};         };       };     };
examples/Orbits.hs view
@@ -117,4 +117,4 @@ showResult = show $ TL.natVal @n Proxy  main :: IO ()-main = putStrLn $ "Number of orbits is " <> showResult+main = putStrLn $ "Number of orbits is " ++ showResult
fcf-containers.cabal view
@@ -6,7 +6,7 @@     contents of containers-package and show how these can be used. Everything is     based on the ideas given in the first-class-families -package. Homepage:            https://github.com/gspia/fcf-containers-Version:             0.1.0+Version:             0.2.0 Build-type:          Simple Author:              gspia Maintainer:          iahogsp@gmail.com@@ -16,17 +16,19 @@ Copyright:           gspia (c) 2020- Extra-source-files:  README.md, TODO.md, CHANGELOG.md, default.nix, shell.nix Cabal-version:       1.24+Tested-With:         GHC ==8.8.1 || ==8.6.5 || ==8.4.4 || ==8.2.2  library   hs-source-dirs:    src   exposed-modules:   Fcf.Data.MapC                    , Fcf.Data.Tree                    , Fcf.Data.Set+                   , Fcf.Data.Symbol                    , Fcf.Alg.List                    , Fcf.Alg.Tree                    , Fcf.Alg.Morphism-  build-depends:     base >= 4.9 && < 4.13-                   , first-class-families >= 0.6 && < 0.7+  build-depends:     base >= 4.9 && < 4.14+                   , first-class-families >= 0.7 && < 0.8   ghc-options:      -Wall   default-language:  Haskell2010   -- ghc-options:@@ -47,14 +49,15 @@      --  -ddump-simpl      --  -O2 --- test-suite fcf-test---   type:                exitcode-stdio-1.0---   hs-source-dirs:      test---   main-is:             test.hs---   default-language:    Haskell2010---   build-depends:---       base---     , first-class-families+test-suite fcf-test+  type:                exitcode-stdio-1.0+  hs-source-dirs:      test+  main-is:             test.hs+  default-language:    Haskell2010+  build-depends:+      base+    , first-class-families+    , fcf-containers  test-suite fcf-doctest   type:                exitcode-stdio-1.0
src/Fcf/Alg/List.hs view
@@ -29,13 +29,24 @@  import qualified GHC.TypeLits as TL -import           Fcf+import           Fcf.Core (Eval, Exp)+import           Fcf.Classes (Map)+import           Fcf.Data.List (Foldr)+import           Fcf.Utils (If)+import           Fcf.Data.Bool (type (&&), type  (||)) import           Fcf.Data.Nat  import           Fcf.Alg.Morphism  -------------------------------------------------------------------------------- +-- For the doctests:++-- $setup+-- >>> import           Fcf.Combinators++--------------------------------------------------------------------------------+ -- | Base functor for a list of type @[a]@. data ListF a b = ConsF a b | NilF @@ -86,7 +97,7 @@  -- | Sum a Nat-list. ----- __Example__+-- === __Example__ -- -- >>> :kind! Eval (Sum '[1,2,3]) -- Eval (Sum '[1,2,3]) :: Nat@@ -98,7 +109,7 @@  -- | Partition -- --- __Example__+-- === __Example__ --  -- >>> :kind! Eval (Fcf.Alg.List.Partition ((>=) 35) '[ 20, 30, 40, 50]) -- Eval (Fcf.Alg.List.Partition ((>=) 35) '[ 20, 30, 40, 50]) :: ([Nat],@@ -107,76 +118,45 @@ data Partition :: (a -> Exp Bool) -> [a] -> Exp ([a],[a]) type instance Eval (Partition p lst) = Eval (Foldr (PartHelp p) '( '[], '[]) lst) +-- helper data PartHelp :: (a -> Exp Bool) -> a -> ([a],[a]) -> Exp ([a],[a]) type instance Eval (PartHelp p a '(xs,ys)) =     If (Eval (p a))         '(a ': xs, ys)         '(xs, a ': ys) +--------------------------------------------------------------------------------  --- | Type-level `Elem` for lists.+-- | Give true if all of the booleans in the list are true. -- -- === __Example__------ >>> :kind! Eval (Elem 1 '[1,2,3])--- Eval (Elem 1 '[1,2,3]) :: Bool+-- +-- >>> :kind! Eval (All '[ 'True, 'True])+-- Eval (All '[ 'True, 'True]) :: Bool -- = 'True--- >>> :kind! Eval (Elem 1 '[2,3])--- Eval (Elem 1 '[2,3]) :: Bool--- = 'False ----- Note: Once Fcf releases a new version, I'll remove this, TODO-data Elem :: a -> [a] -> Exp Bool-type instance Eval (Elem a as) = Eval (IsJust =<< FindIndex (TyEq a) as)---- | Concat for lists.------ === __Example__------ >>> :kind! Eval (Concat ( '[ '[1,2], '[3,4], '[5,6]]))--- Eval (Concat ( '[ '[1,2], '[3,4], '[5,6]])) :: [Nat]--- = '[1, 2, 3, 4, 5, 6]--- >>> :kind! Eval (Concat ( '[ '[Int, Maybe Int], '[Maybe String, Either Double Int]]))--- Eval (Concat ( '[ '[Int, Maybe Int], '[Maybe String, Either Double Int]])) :: [*]--- = '[Int, Maybe Int, Maybe String, Either Double Int]------ Note: Once Fcf releases a new version, I'll remove this, TODO-data Concat :: [[a]] -> Exp [a]-type instance Eval (Concat lsts) = Eval (Foldr (++) '[] lsts)+-- >>> :kind! Eval (All '[ 'True, 'True, 'False])+-- Eval (All '[ 'True, 'True, 'False]) :: Bool+-- = 'False+data All :: [Bool] -> Exp Bool+type instance Eval (All lst) = Eval (Foldr (&&) 'True lst)  --- | ConcatMap for lists.------ Note: Once Fcf releases a new version, I'll remove this, TODO-data ConcatMap :: (a -> Exp [b]) -> [a] -> Exp [b]-type instance Eval (ConcatMap f lst) = Eval (Concat (Eval (Map f lst)))---- | Type-level Unfoldr.+-- | Give true if any of the booleans in the list is true. -- -- === __Example__------ >>> data ToThree :: Nat -> Exp (Maybe (Nat, Nat))--- >>> :{--- type instance Eval (ToThree b) =---   If (Eval (b Fcf.>= 4))---     'Nothing---     ('Just '(b, b TL.+ 1))--- :}------ >>> :kind! Eval (Unfoldr ToThree 0)--- Eval (Unfoldr ToThree 0) :: [Nat]--- = '[0, 1, 2, 3]------ Note: Once Fcf releases a new version, I'll remove this, TODO-data Unfoldr :: (b -> Exp (Maybe (a, b))) -> b -> Exp [a]-type instance Eval (Unfoldr f c) = Eval (UnfoldrCase f (f @@ c))+-- +-- >>> :kind! Eval (Any '[ 'True, 'True])+-- Eval (Any '[ 'True, 'True]) :: Bool+-- = 'True+-- +-- >>> :kind! Eval (Any '[ 'False, 'False])+-- Eval (Any '[ 'False, 'False]) :: Bool+-- = 'False+data Any :: [Bool] -> Exp Bool+type instance Eval (Any lst) = Eval (Foldr (||) 'False lst) --- Helper for the Unfoldr.--- Note: Once Fcf releases a new version, I'll remove this, TODO-data UnfoldrCase :: (b -> Exp (Maybe (a, b))) -> Maybe (a, b) -> Exp [a]-type instance Eval (UnfoldrCase f ('Just ab)) =-  Eval (Fst ab) ': Eval (Unfoldr f (Eval (Snd ab)))-type instance Eval (UnfoldrCase _ 'Nothing) = '[]+  
src/Fcf/Alg/Morphism.hs view
@@ -64,7 +64,7 @@  -- | Ana can also be used to build a 'Fix' structure. ----- __Example__+-- === __Example__ --  -- >>> data NToOneCoA :: CoAlgebra (ListF Nat) Nat -- >>> :{ @@ -85,7 +85,7 @@ -- Hylomorphism uses first 'Ana' to build a structure (unfold) and then 'Cata' -- to process the structure (fold). -- --- __Example__+-- === __Example__ --  -- >>> data NToOneCoA :: CoAlgebra (ListF Nat) Nat -- >>> :{ @@ -105,7 +105,7 @@  -- | Type-level First. Tuples @(,)@ and @Either@ have First-instances. -- --- __Example__+-- === __Example__ --  -- >>> :kind! Eval (First ((+) 1) '(3,"a")) -- Eval (First ((+) 1) '(3,"a")) :: (Nat, TL.Symbol)@@ -121,7 +121,7 @@  -- | Type-level Second. Tuples @(,)@ and @Either@ have Second-instances. -- --- __Example__+-- === __Example__ --  -- >>> :kind! Eval (Second ((+) 1) '("a",3)) -- Eval (Second ((+) 1) '("a",3)) :: (TL.Symbol, Nat)
src/Fcf/Data/MapC.hs view
@@ -33,16 +33,56 @@  -------------------------------------------------------------------------------- -module Fcf.Data.MapC where+module Fcf.Data.MapC+    ( -- * MapC type+      MapC (..) +    -- * Query+    , Null+    , Size+    , Lookup+    , Member+    , NotMember+    , Disjoint+    , Elems+    , Keys+    , Assocs++    -- * Construction+    , Empty+    , Singleton+    , Insert+    , InsertWith+    , Delete++    -- * Combine+    , Union+    , Difference+    , Intersection++    -- * Modify+    , Adjust+    , Map+    , MapWithKey+    , Foldr+    , Filter+    , FilterWithKey+    , Partition++    -- * List+    , FromList+    , ToList++    )+  where+ import qualified GHC.TypeLits as TL  import           Fcf ( Eval, Exp, Fst, Snd, type (=<<), type (<=<), type (@@)                      , type (++), Not, If                      , Pure, TyEq, Length, Uncurry) import qualified Fcf as Fcf (Map, Foldr, Filter)--- import           Fcf.Data.List (Elem) -- TODO: change on fcf 0.7-import           Fcf.Alg.List (Elem) -- TODO: change on fcf 0.7+import           Fcf.Data.List (Elem)  import           Fcf.Alg.Morphism import qualified Fcf.Alg.List as Fcf (Partition)@@ -52,8 +92,9 @@ -- For the doctests:  -- $setup--- >>> import Fcf ( type (>=), Pure1, Pure2 )+-- >>> import           Fcf (type (>=)) -- >>> import           Fcf.Data.Nat+-- >>> import           Fcf.Data.Symbol (Symbol,Append)  -------------------------------------------------------------------------------- @@ -69,10 +110,10 @@  -- | Empty -- --- __Example__+-- === __Example__ -- --- >>> :kind! (Eval Empty :: MapC Nat TL.Symbol)--- (Eval Empty :: MapC Nat TL.Symbol) :: MapC Nat TL.Symbol+-- >>> :kind! (Eval Empty :: MapC Nat Symbol)+-- (Eval Empty :: MapC Nat Symbol) :: MapC Nat Symbol -- = 'MapC '[] -- -- >>> :kind! (Eval Empty :: MapC Int String)@@ -85,31 +126,31 @@  -- | Singleton -- --- __Example__+-- === __Example__ --  -- >>> :kind! Eval (Singleton 1 "haa")--- Eval (Singleton 1 "haa") :: MapC Nat TL.Symbol+-- Eval (Singleton 1 "haa") :: MapC Nat Symbol -- = 'MapC '[ '(1, "haa")] data Singleton :: k -> v -> Exp (MapC k v) type instance Eval (Singleton k v) = 'MapC '[ '(k,v)]  -- | Use FromList to construct a MapC from type-level list. ----- __Example__+-- === __Example__ --  -- >>> :kind! Eval (FromList '[ '(1,"haa"), '(2,"hoo")])--- Eval (FromList '[ '(1,"haa"), '(2,"hoo")]) :: MapC Nat TL.Symbol+-- Eval (FromList '[ '(1,"haa"), '(2,"hoo")]) :: MapC Nat Symbol -- = 'MapC '[ '(1, "haa"), '(2, "hoo")] data FromList :: [(k,v)] -> Exp (MapC k v) type instance Eval (FromList lst) = 'MapC lst  -- | Insert ----- __Example__+-- === __Example__ -- -- >>> :kind! Eval (Insert 3 "hih" =<< FromList '[ '(1,"haa"), '(2,"hoo")]) -- Eval (Insert 3 "hih" =<< FromList '[ '(1,"haa"), '(2,"hoo")]) :: MapC ---                                                                    Nat TL.Symbol+--                                                                    Nat Symbol -- = 'MapC '[ '(3, "hih"), '(1, "haa"), '(2, "hoo")] data Insert :: k -> v -> MapC k v -> Exp (MapC k v) type instance Eval (Insert k v ('MapC lst)) =@@ -122,24 +163,20 @@ -- if old there, map -- if no old, add ----- __Example__+-- === __Example__ -- --- >>> :kind! Eval (InsertWith (Pure2 TL.AppendSymbol) 5 "xxx" (Eval (FromList '[ '(5,"a"), '(3,"b")])))--- Eval (InsertWith (Pure2 TL.AppendSymbol) 5 "xxx" (Eval (FromList '[ '(5,"a"), '(3,"b")]))) :: MapC ---                                                                                                 Nat ---                                                                                                 TL.Symbol+-- >>> :kind! Eval (InsertWith Append 5 "xxx" =<< FromList '[ '(5,"a"), '(3,"b")])+-- Eval (InsertWith Append 5 "xxx" =<< FromList '[ '(5,"a"), '(3,"b")]) :: MapC+--                                                                           Nat Symbol -- = 'MapC '[ '(5, "xxxa"), '(3, "b")] ----- >>> :kind! Eval (InsertWith (Pure2 TL.AppendSymbol) 7 "xxx" (Eval (FromList '[ '(5,"a"), '(3,"b")])))--- Eval (InsertWith (Pure2 TL.AppendSymbol) 7 "xxx" (Eval (FromList '[ '(5,"a"), '(3,"b")]))) :: MapC ---                                                                                                 Nat ---                                                                                                 TL.Symbol+-- >>> :kind! Eval (InsertWith Append 7 "xxx" =<< FromList '[ '(5,"a"), '(3,"b")])+-- Eval (InsertWith Append 7 "xxx" =<< FromList '[ '(5,"a"), '(3,"b")]) :: MapC+--                                                                           Nat Symbol -- = 'MapC '[ '(5, "a"), '(3, "b"), '(7, "xxx")]------ >>> :kind! Eval (InsertWith (Pure2 TL.AppendSymbol) 5 "xxx" =<< Empty)--- Eval (InsertWith (Pure2 TL.AppendSymbol) 5 "xxx" =<< Empty) :: MapC ---                                                                  Nat TL.Symbol--- = 'MapC '[ '(5, "xxx")]+-- >>> :kind! Eval (InsertWith Append 7 "xxx" =<< Empty)+-- Eval (InsertWith Append 7 "xxx" =<< Empty) :: MapC Nat Symbol+-- = 'MapC '[ '(7, "xxx")] data InsertWith :: (v -> v -> Exp v) -> k -> v -> MapC k v -> Exp (MapC k v) type instance Eval (InsertWith f k v ('MapC lst)) =     If (Eval (Elem k =<< Fcf.Map Fst lst))@@ -156,20 +193,20 @@  -- | Delete -- --- __Example__+-- === __Example__ -- --- >>> :kind! Eval (Delete 5 (Eval (FromList '[ '(5,"a"), '(3,"b")])))--- Eval (Delete 5 (Eval (FromList '[ '(5,"a"), '(3,"b")]))) :: MapC ---                                                               Nat TL.Symbol+-- >>> :kind! Eval (Delete 5 =<< FromList '[ '(5,"a"), '(3,"b")])+-- Eval (Delete 5 =<< FromList '[ '(5,"a"), '(3,"b")]) :: MapC+--                                                          Nat Symbol -- = 'MapC '[ '(3, "b")] ----- >>> :kind! Eval (Delete 7 (Eval (FromList '[ '(5,"a"), '(3,"b")])))--- Eval (Delete 7 (Eval (FromList '[ '(5,"a"), '(3,"b")]))) :: MapC ---                                                               Nat TL.Symbol+-- >>> :kind! Eval (Delete 7 =<< FromList '[ '(5,"a"), '(3,"b")])+-- Eval (Delete 7 =<< FromList '[ '(5,"a"), '(3,"b")]) :: MapC+--                                                          Nat Symbol -- = 'MapC '[ '(5, "a"), '(3, "b")] ----- >>> :kind! Eval (Delete 7 (Eval Empty))--- Eval (Delete 7 (Eval Empty)) :: MapC Nat v+-- >>> :kind! Eval (Delete 7 =<< Empty)+-- Eval (Delete 7 =<< Empty) :: MapC Nat v -- = 'MapC '[] data Delete :: k -> MapC k v -> Exp (MapC k v) type instance Eval (Delete k ('MapC lst)) =@@ -177,23 +214,20 @@  -- | Adjust -- --- __Example__+-- === __Example__ -- --- >>> :kind! Eval (Adjust (Pure1 (TL.AppendSymbol "new ")) 5 (Eval (FromList '[ '(5,"a"), '(3,"b")])))--- Eval (Adjust (Pure1 (TL.AppendSymbol "new ")) 5 (Eval (FromList '[ '(5,"a"), '(3,"b")]))) :: MapC ---                                                                                                Nat ---                                                                                                TL.Symbol+-- >>> :kind! Eval (Adjust (Append "new ") 5 =<< FromList '[ '(5,"a"), '(3,"b")])+-- Eval (Adjust (Append "new ") 5 =<< FromList '[ '(5,"a"), '(3,"b")]) :: MapC+--                                                                          Nat Symbol -- = 'MapC '[ '(5, "new a"), '(3, "b")] ----- >>> :kind! Eval (Adjust (Pure1 (TL.AppendSymbol "new ")) 7 (Eval (FromList '[ '(5,"a"), '(3,"b")])))--- Eval (Adjust (Pure1 (TL.AppendSymbol "new ")) 7 (Eval (FromList '[ '(5,"a"), '(3,"b")]))) :: MapC ---                                                                                                Nat ---                                                                                                TL.Symbol+-- >>> :kind! Eval (Adjust (Append "new ") 7 =<< FromList '[ '(5,"a"), '(3,"b")])+-- Eval (Adjust (Append "new ") 7 =<< FromList '[ '(5,"a"), '(3,"b")]) :: MapC+--                                                                          Nat Symbol -- = 'MapC '[ '(5, "a"), '(3, "b")] ----- >>> :kind! Eval (Adjust (Pure1 (TL.AppendSymbol "new "))  7 (Eval Empty))--- Eval (Adjust (Pure1 (TL.AppendSymbol "new "))  7 (Eval Empty)) :: MapC ---                                                                     Nat TL.Symbol+-- >>> :kind! Eval (Adjust (Append "new ") 7 =<< Empty)+-- Eval (Adjust (Append "new ") 7 =<< Empty) :: MapC Nat Symbol -- = 'MapC '[] data Adjust :: (v -> Exp v) -> k -> MapC k v -> Exp (MapC k v) type instance Eval (Adjust f k ('MapC lst)) =@@ -209,16 +243,14 @@  -- | Lookup ----- __Example__+-- === __Example__ -- --- >>> :kind! Eval (Lookup 5 (Eval (FromList '[ '(5,"a"), '(3,"b")])))--- Eval (Lookup 5 (Eval (FromList '[ '(5,"a"), '(3,"b")]))) :: Maybe ---                                                               TL.Symbol+-- >>> :kind! Eval (Lookup 5 =<< FromList '[ '(5,"a"), '(3,"b")])+-- Eval (Lookup 5 =<< FromList '[ '(5,"a"), '(3,"b")]) :: Maybe Symbol -- = 'Just "a" ----- >>> :kind! Eval (Lookup 7 (Eval (FromList '[ '(5,"a"), '(3,"b")])))--- Eval (Lookup 7 (Eval (FromList '[ '(5,"a"), '(3,"b")]))) :: Maybe ---                                                               TL.Symbol+-- >>> :kind! Eval (Lookup 7 =<< FromList '[ '(5,"a"), '(3,"b")])+-- Eval (Lookup 7 =<< FromList '[ '(5,"a"), '(3,"b")]) :: Maybe Symbol -- = 'Nothing data Lookup :: k -> MapC k v -> Exp (Maybe v) type instance Eval (Lookup k ('MapC '[])) = 'Nothing@@ -230,13 +262,13 @@  -- | Member ----- __Example__+-- === __Example__ -- --- >>> :kind! Eval (Member 5 (Eval (FromList '[ '(5,"a"), '(3,"b")])))--- Eval (Member 5 (Eval (FromList '[ '(5,"a"), '(3,"b")]))) :: Bool+-- >>> :kind! Eval (Member 5 =<< FromList '[ '(5,"a"), '(3,"b")])+-- Eval (Member 5 =<< FromList '[ '(5,"a"), '(3,"b")]) :: Bool -- = 'True--- >>> :kind! Eval (Member 7 (Eval (FromList '[ '(5,"a"), '(3,"b")])))--- Eval (Member 7 (Eval (FromList '[ '(5,"a"), '(3,"b")]))) :: Bool+-- >>> :kind! Eval (Member 7 =<< FromList '[ '(5,"a"), '(3,"b")])+-- Eval (Member 7 =<< FromList '[ '(5,"a"), '(3,"b")]) :: Bool -- = 'False data Member :: k -> MapC k v -> Exp Bool type instance Eval (Member k mp) =@@ -244,13 +276,13 @@  -- | NotMember ----- __Example__+-- === __Example__ -- --- >>> :kind! Eval (NotMember 5 (Eval (FromList '[ '(5,"a"), '(3,"b")])))--- Eval (NotMember 5 (Eval (FromList '[ '(5,"a"), '(3,"b")]))) :: Bool+-- >>> :kind! Eval (NotMember 5 =<< FromList '[ '(5,"a"), '(3,"b")])+-- Eval (NotMember 5 =<< FromList '[ '(5,"a"), '(3,"b")]) :: Bool -- = 'False--- >>> :kind! Eval (NotMember 7 (Eval (FromList '[ '(5,"a"), '(3,"b")])))--- Eval (NotMember 7 (Eval (FromList '[ '(5,"a"), '(3,"b")]))) :: Bool+-- >>> :kind! Eval (NotMember 7 =<< FromList '[ '(5,"a"), '(3,"b")])+-- Eval (NotMember 7 =<< FromList '[ '(5,"a"), '(3,"b")]) :: Bool -- = 'True data NotMember :: k -> MapC k v -> Exp Bool type instance Eval (NotMember k mp) =@@ -258,7 +290,7 @@  -- | Null ----- __Example__+-- === __Example__ --  -- >>> :kind! Eval (Null =<< FromList '[ '(5,"a"), '(3,"b")]) -- Eval (Null =<< FromList '[ '(5,"a"), '(3,"b")]) :: Bool@@ -272,7 +304,7 @@  -- | Size ----- __Example__+-- === __Example__ --  -- >>> :kind! Eval (Size =<< FromList '[ '(5,"a"), '(3,"b")]) -- Eval (Size =<< FromList '[ '(5,"a"), '(3,"b")]) :: Nat@@ -282,12 +314,12 @@  -- | Union ----- __Example__+-- === __Example__ --  -- >>> :kind! Eval (Union (Eval (FromList '[ '(5,"a"), '(3,"b")])) (Eval (FromList '[ '(5,"A"), '(7,"c")])) ) -- Eval (Union (Eval (FromList '[ '(5,"a"), '(3,"b")])) (Eval (FromList '[ '(5,"A"), '(7,"c")])) ) :: MapC  --                                                                                                      Nat ---                                                                                                      TL.Symbol+--                                                                                                      Symbol -- = 'MapC '[ '(7, "c"), '(5, "a"), '(3, "b")] data Union :: MapC k v -> MapC k v -> Exp (MapC k v) type instance Eval (Union ('MapC lst1) ('MapC lst2)) =@@ -302,12 +334,12 @@  -- | Difference -- --- __Example__+-- === __Example__ --  -- >>> :kind! Eval (Difference (Eval (FromList '[ '(3,"a"), '(5,"b")])) (Eval (FromList '[ '(5,"B"), '(7,"C")]))) -- Eval (Difference (Eval (FromList '[ '(3,"a"), '(5,"b")])) (Eval (FromList '[ '(5,"B"), '(7,"C")]))) :: MapC  --                                                                                                          Nat ---                                                                                                          TL.Symbol+--                                                                                                          Symbol -- = 'MapC '[ '(3, "a")] data Difference :: MapC k v -> MapC k v -> Exp (MapC k v) type instance Eval (Difference mp1 mp2) =@@ -321,12 +353,12 @@  -- | Intersection ----- __Example__+-- === __Example__ --  -- >>> :kind! Eval (Intersection (Eval (FromList '[ '(3,"a"), '(5,"b")])) (Eval (FromList '[ '(5,"B"), '(7,"C")]))) -- Eval (Intersection (Eval (FromList '[ '(3,"a"), '(5,"b")])) (Eval (FromList '[ '(5,"B"), '(7,"C")]))) :: MapC  --                                                                                                            Nat ---                                                                                                            TL.Symbol+--                                                                                                            Symbol -- = 'MapC '[ '(5, "b")] data Intersection :: MapC k v -> MapC k v -> Exp (MapC k v) type instance Eval (Intersection mp1 mp2) =@@ -339,7 +371,7 @@  -- | Disjoint ----- __Example__+-- === __Example__ --  -- >>> :kind! Eval (Disjoint (Eval (FromList '[ '(3,"a"), '(5,"b")])) (Eval (FromList '[ '(5,"B"), '(7,"C")]))) -- Eval (Disjoint (Eval (FromList '[ '(3,"a"), '(5,"b")])) (Eval (FromList '[ '(5,"B"), '(7,"C")]))) :: Bool@@ -358,10 +390,10 @@  -- Map  ----- __Example__+-- === __Example__ ----- >>> :kind! Eval (Fcf.Data.MapC.Map (Pure1 (TL.AppendSymbol "x")) =<< FromList '[ '(5,"a"), '(3,"b")])--- Eval (Fcf.Data.MapC.Map (Pure1 (TL.AppendSymbol "x")) =<< FromList '[ '(5,"a"), '(3,"b")]) :: MapC Nat TL.Symbol+-- >>> :kind! Eval (Fcf.Data.MapC.Map (Append "x") =<< FromList '[ '(5,"a"), '(3,"b")])+-- Eval (Fcf.Data.MapC.Map (Append "x") =<< FromList '[ '(5,"a"), '(3,"b")]) :: MapC Nat Symbol -- = 'MapC '[ '(5, "xa"), '(3, "xb")] data Map :: (v -> Exp w) -> MapC k v -> Exp (MapC k w) type instance Eval (Map f mp) =@@ -369,7 +401,7 @@  -- MapWithKey  ----- __Example__+-- === __Example__ --  data MapWithKey :: (k -> v -> Exp w) -> MapC k v -> Exp (MapC k w) type instance Eval (MapWithKey f mp) =@@ -389,10 +421,10 @@ -- -- Note: the order of values in MapC is not well defined at the moment. ----- __Example__+-- === __Example__ -- --- >>> :kind! Eval (Fcf.Data.MapC.Foldr (Pure2 (TL.+)) 0  =<< (FromList '[ '(1,1), '(2,2)]))--- Eval (Fcf.Data.MapC.Foldr (Pure2 (TL.+)) 0  =<< (FromList '[ '(1,1), '(2,2)])) :: Nat+-- >>> :kind! Eval (Fcf.Data.MapC.Foldr (+) 0  =<< (FromList '[ '(1,1), '(2,2)]))+-- Eval (Fcf.Data.MapC.Foldr (+) 0  =<< (FromList '[ '(1,1), '(2,2)])) :: Nat -- = 3 data Foldr :: (v -> w -> Exp w) -> w -> MapC k v -> Exp w type instance Eval (Foldr f w mp) = Eval (Fcf.Foldr f w =<< Elems mp)@@ -400,10 +432,10 @@  -- | Elems ----- __Example__+-- === __Example__ --  -- >>> :kind! Eval (Elems =<< FromList '[ '(5,"a"), '(3,"b")])--- Eval (Elems =<< FromList '[ '(5,"a"), '(3,"b")]) :: [TL.Symbol]+-- Eval (Elems =<< FromList '[ '(5,"a"), '(3,"b")]) :: [Symbol] -- = '["a", "b"] -- >>> :kind! Eval (Elems =<< Empty) -- Eval (Elems =<< Empty) :: [v]@@ -413,7 +445,7 @@  -- | Keys ----- __Example__+-- === __Example__ --  -- >>> :kind! Eval (Keys =<< FromList '[ '(5,"a"), '(3,"b")]) -- Eval (Keys =<< FromList '[ '(5,"a"), '(3,"b")]) :: [Nat]@@ -426,11 +458,11 @@  -- | Assocs ----- __Example__+-- === __Example__ --  -- >>> :kind! Eval (Assocs =<< FromList '[ '(5,"a"), '(3,"b")]) -- Eval (Assocs =<< FromList '[ '(5,"a"), '(3,"b")]) :: [(Nat, ---                                                        TL.Symbol)]+--                                                        Symbol)] -- = '[ '(5, "a"), '(3, "b")] -- >>> :kind! Eval (Assocs =<< Empty) -- Eval (Assocs =<< Empty) :: [(k, v)]@@ -440,11 +472,11 @@  -- | ToList ----- __Example__+-- === __Example__ --  -- >>> :kind! Eval (ToList =<< FromList '[ '(5,"a"), '(3,"b")]) -- Eval (ToList =<< FromList '[ '(5,"a"), '(3,"b")]) :: [(Nat, ---                                                        TL.Symbol)]+--                                                        Symbol)] -- = '[ '(5, "a"), '(3, "b")] -- >>> :kind! Eval (ToList =<< Empty) -- Eval (ToList =<< Empty) :: [(k, v)]@@ -454,7 +486,7 @@  -- | Filter ----- __Example__+-- === __Example__ --  -- >>> :kind! Eval (Filter ((>=) 35) =<< FromList '[ '(5,50), '(3,30)]) -- Eval (Filter ((>=) 35) =<< FromList '[ '(5,50), '(3,30)]) :: MapC @@ -466,11 +498,11 @@  -- | FilterWithKey ----- __Example__+-- === __Example__ ----- >>> :kind! Eval (FilterWithKey (>=) (Eval (FromList '[ '(3,5), '(6,4)])))--- Eval (FilterWithKey (>=) (Eval (FromList '[ '(3,5), '(6,4)]))) :: MapC ---                                                                     Nat Nat+-- >>> :kind! Eval (FilterWithKey (>=) =<< FromList '[ '(3,5), '(6,4)])+-- Eval (FilterWithKey (>=) =<< FromList '[ '(3,5), '(6,4)]) :: MapC+--                                                                Nat Nat -- = 'MapC '[ '(6, 4)] data FilterWithKey :: (k -> v -> Exp Bool) -> MapC k v -> Exp (MapC k v) type instance Eval (FilterWithKey f ('MapC lst)) =@@ -478,7 +510,7 @@  -- | Partition ----- __Example__+-- === __Example__ --  -- >>> :kind! Eval (Partition ((>=) 35) =<< FromList '[ '(5,50), '(3,30)]) -- Eval (Partition ((>=) 35) =<< FromList '[ '(5,50), '(3,30)]) :: (MapC 
src/Fcf/Data/Set.hs view
@@ -28,17 +28,45 @@  -------------------------------------------------------------------------------- -module Fcf.Data.Set where+module Fcf.Data.Set+    ( Set (..) +    -- * Query+    , Member+    , NotMember+    , Null+    , Size+      +    -- * Construction+    , Empty+    , Singleton+    , Insert+    , Delete+    , PowerSet++    -- * Combine+    , Union+    , Difference+    , Intersection++    -- * List+    , FromList+    , ToList+    )+  where+ import qualified GHC.TypeLits as TL  import           Fcf ( Eval, Exp, type (=<<), type (<=<)-                     , Not, If-                     , TyEq, Length)--- import           Fcf.Data.List as Fcf+                     , Not, If, Map, TyEq ) import qualified Fcf as Fcf (Foldr, Filter)-import           Fcf.Data.List (Elem)+import           Fcf.Data.List ( Elem, Cons, Concat, Reverse, Length, type (++)+                               , ZipWith, Replicate) ++import           Fcf.Alg.List+import           Fcf.Alg.Morphism+ --------------------------------------------------------------------------------  -- For the doctests:@@ -46,15 +74,18 @@ -- $setup -- >>> import qualified GHC.TypeLits as TL -- >>> import           Fcf.Data.Nat+-- >>> import           Fcf.Data.Symbol  --------------------------------------------------------------------------------  -- | Set-definition. data Set a = Set [a] ++ -- | Empty -- --- __Example__+-- === __Example__ --  -- >>> :kind! (Eval Empty :: Set Nat) -- (Eval Empty :: Set Nat) :: Set Nat@@ -66,7 +97,7 @@  -- | Singleton -- --- __Example__+-- === __Example__ --  -- >>> :kind! Eval (Singleton 1) -- Eval (Singleton 1) :: Set Nat@@ -74,20 +105,10 @@ data Singleton :: v -> Exp (Set v) type instance Eval (Singleton v) = 'Set '[v] --- | Use FromList to construct a Set from type-level list.------ __Example__--- --- >>> :kind! Eval (FromList '[1, 2])--- Eval (FromList '[1, 2]) :: Set Nat--- = 'Set '[1, 2]-data FromList :: [v] -> Exp (Set v)-type instance Eval (FromList lst) = 'Set lst - -- | Insert ----- __Example__+-- === __Example__ -- -- >>> :kind! Eval (Insert 3 =<< FromList '[1, 2]) -- Eval (Insert 3 =<< FromList '[1, 2]) :: Set Nat@@ -104,7 +125,7 @@  -- | Delete -- --- __Example__+-- === __Example__ --  -- >>> :kind! Eval (Delete 5 =<< FromList '[5, 3]) -- Eval (Delete 5 =<< FromList '[5, 3]) :: Set Nat@@ -119,7 +140,7 @@  -- | Member ----- __Example__+-- === __Example__ --  -- >>> :kind! Eval (Member 5 =<< FromList '[5, 3]) -- Eval (Member 5 =<< FromList '[5, 3]) :: Bool@@ -132,7 +153,7 @@  -- | NotMember ----- __Example__+-- === __Example__ --  -- >>> :kind! Eval (NotMember 5 =<< FromList '[5, 3]) -- Eval (NotMember 5 =<< FromList '[5, 3]) :: Bool@@ -144,9 +165,10 @@ type instance Eval (NotMember k ('Set lst)) =     Eval (Not =<< Elem k lst) + -- | Null ----- __Example__+-- === __Example__ --  -- >>> :kind! Eval (Null =<< FromList '[5, 3]) -- Eval (Null =<< FromList '[5, 3]) :: Bool@@ -158,9 +180,10 @@ type instance Eval (Null ('Set '[])) = 'True type instance Eval (Null ('Set (_ ': _))) = 'False + -- | Size ----- __Example__+-- === __Example__ --  -- >>> :kind! Eval (Size =<< FromList '[5, 3]) -- Eval (Size =<< FromList '[5, 3]) :: Nat@@ -168,9 +191,10 @@ data Size :: Set v -> Exp TL.Nat type instance Eval (Size ('Set lst)) = Eval (Length lst) --- | Union++-- | Type-level set union. ----- __Example__+-- === __Example__ --  -- >>> :kind! Eval (Union (Eval (FromList '[5, 3])) (Eval (FromList '[5, 7])) ) -- Eval (Union (Eval (FromList '[5, 3])) (Eval (FromList '[5, 7])) ) :: Set @@ -187,9 +211,9 @@         (v ': lst)  --- | Difference+-- | Type-level set difference. -- --- __Example__+-- === __Example__ --  -- >>> :kind! Eval (Difference (Eval (FromList '[3, 5])) (Eval (FromList '[5, 7]))) -- Eval (Difference (Eval (FromList '[3, 5])) (Eval (FromList '[5, 7]))) :: Set @@ -204,9 +228,9 @@ type instance Eval (DiffNotMem lst v) = Eval (Not =<< Elem v lst)  --- | Intersection+-- | Type-level set intersection. ----- __Example__+-- === __Example__ --  -- >>> :kind! Eval (Intersection (Eval (FromList '[3, 5])) (Eval (FromList '[5, 7]))) -- Eval (Intersection (Eval (FromList '[3, 5])) (Eval (FromList '[5, 7]))) :: Set @@ -219,3 +243,89 @@ -- helper data InterMem :: [v ]-> v -> Exp Bool type instance Eval (InterMem lst v) = Eval (Elem v lst)++--------------------------------------------------------------------------------++-- helper for PowerSet+data AddFalses :: [[Bool]] -> Exp [[Bool]]+type instance Eval (AddFalses lst) = Eval (Map (Cons 'False) lst)++-- helper for PowerSet+data AddTrues :: [[Bool]] -> Exp [[Bool]]+type instance Eval (AddTrues lst) = Eval (Map (Cons 'True) lst)++-- helper for PowerSet+data ExtendBitList :: [[Bool]] -> Exp [[Bool]]+type instance Eval (ExtendBitList lst) =+    Eval ((Eval (AddFalses lst)) ++ (Eval (AddTrues =<< Map Reverse lst)))++-- helper for PowerSet+-- :kind! Eval (Cata BuildGrayBitListsAlg=<< ListToFix =<< Replicate 3 '[])+data BuildGrayBitListsAlg :: Algebra (ListF [[Bool]]) [[Bool]]+type instance Eval (BuildGrayBitListsAlg 'NilF) = '[ '[] ]+type instance Eval (BuildGrayBitListsAlg ('ConsF _ lst)) = Eval (ExtendBitList lst)++-- helper for PowerSet+-- :kind! Eval (BuildGrayBitLists '[1,2,3,4])+data BuildGrayBitLists :: [a] -> Exp [[Bool]]+type instance Eval (BuildGrayBitLists lst) =+    Eval (Cata BuildGrayBitListsAlg =<< ListToFix =<< Replicate (Eval (Length lst)) '[])++-- helper for PowerSet+data SelWithBool :: a -> Bool -> Exp [a]+type instance Eval (SelWithBool a b) = If b '[a] '[]++-- helper for PowerSet+data SelectWithBools :: [a] -> [Bool] -> Exp [a]+type instance Eval (SelectWithBools elms bls) =+    Eval (Concat =<< ZipWith SelWithBool elms bls)++-- | Calculate the power sets of a given type-level list. The algorithm is based +-- Gray codes.+--+-- === __Example__+--+-- >>> :kind! Eval (PowerSet =<< FromList '["a", "b", "c"])+-- Eval (PowerSet =<< FromList '["a", "b", "c"]) :: Set (Set Symbol)+-- = 'Set+--     '[ 'Set '[], 'Set '["c"], 'Set '["b"], 'Set '["b", "c"],+--        'Set '["a"], 'Set '["a", "b"], 'Set '["a", "c"],+--        'Set '["a", "b", "c"]]+--+-- >>> :kind! Eval (PowerSet =<< FromList '[Int, Char, Maybe Int])+-- Eval (PowerSet =<< FromList '[Int, Char, Maybe Int]) :: Set (Set *)+-- = 'Set+--     '[ 'Set '[], 'Set '[Maybe Int], 'Set '[Char],+--        'Set '[Char, Maybe Int], 'Set '[Int], 'Set '[Int, Char],+--        'Set '[Int, Maybe Int], 'Set '[Int, Char, Maybe Int]]+--+data PowerSet :: Set a -> Exp (Set (Set a))+type instance Eval (PowerSet ('Set lst)) =+    'Set (Eval (Map FromList+               =<< Map (SelectWithBools lst)+               =<< BuildGrayBitLists lst))++--------------------------------------------------------------------------------++-- | Use FromList to construct a Set from type-level list.+--+-- === __Example__+-- +-- >>> :kind! Eval (FromList '[1, 2])+-- Eval (FromList '[1, 2]) :: Set Nat+-- = 'Set '[1, 2]+data FromList :: [v] -> Exp (Set v)+type instance Eval (FromList lst) = 'Set lst++-- | Get the type-level list out of the 'Set'.+--+-- === __Example__+-- +-- >>> :kind! Eval (ToList =<< PowerSet =<< FromList '[1,2,3])+-- Eval (ToList =<< PowerSet =<< FromList '[1,2,3]) :: [Set Nat]+-- = '[ 'Set '[], 'Set '[3], 'Set '[2], 'Set '[2, 3], 'Set '[1],+--      'Set '[1, 2], 'Set '[1, 3], 'Set '[1, 2, 3]]+data ToList :: Set v -> Exp [v]+type instance Eval (ToList ('Set lst)) = lst++
+ src/Fcf/Data/Symbol.hs view
@@ -0,0 +1,152 @@+{-# LANGUAGE DataKinds              #-}+{-# LANGUAGE PolyKinds              #-}+{-# LANGUAGE TypeFamilies           #-}+{-# LANGUAGE TypeInType             #-}+{-# LANGUAGE TypeOperators          #-}+{-# LANGUAGE UndecidableInstances   #-}+{-# OPTIONS_GHC -Wall                       #-}+{-# OPTIONS_GHC -Werror=incomplete-patterns #-}++{-|+Module      : Fcf.Data.Symbol+Description : Type level symbols+Copyright   : (c) gspia 2020-+License     : BSD+Maintainer  : gspia++= Fcf.Data.Symbol++Type-level symbols and functions for them.++Note that the operators from this module conflict with "GHC.TypeLits".+++-}++--------------------------------------------------------------------------------++module Fcf.Data.Symbol+    ( -- * Reexported type+      -- | From "GHC.TypeList".++      Symbol++      -- * Functions++    , Append+    , Intercalate++     -- * Comparison functions++    , type (<=)+    , type (>=)+    , type (<)+    , type (>)+    , type (==)+    )+  where++--------------------------------------------------------------------------------+        +import           GHC.TypeLits (Symbol)+import qualified GHC.TypeLits as TL++import           Fcf.Core (Eval, Exp)+import           Fcf.Data.List (Foldr)+import           Fcf.Data.Bool (type (||))+import           Fcf.Utils (TyEq)++import           Fcf.Combinators (type (=<<))++--------------------------------------------------------------------------------++-- | Append two type-level symbols.+--+-- === __Example__+-- +-- >>> :kind! Eval (Append "hmm" " ok")+-- Eval (Append "hmm" " ok") :: Symbol+-- = "hmm ok"+data Append :: Symbol -> Symbol -> Exp Symbol+type instance Eval (Append s1 s2) = TL.AppendSymbol s1 s2+++-- | Intercalate type-level symbols.+-- +-- === __Example__+-- +-- >>> :kind! Eval (Intercalate "+" '["aa", "bb", "cc"])+-- Eval (Intercalate "+" '["aa", "bb", "cc"]) :: Symbol+-- = "aa+bb+cc"+--+-- >>> :kind! Eval (Intercalate "+" '["aa"])+-- Eval (Intercalate "+" '["aa"]) :: Symbol+-- = "aa"+--+-- >>> :kind! Eval (Intercalate "+" '[])+-- Eval (Intercalate "+" '[]) :: Symbol+-- = ""+data Intercalate :: Symbol -> [Symbol] -> Exp Symbol+type instance Eval (Intercalate s1 '[]) = ""+type instance Eval (Intercalate s1 (s ': sLst)) =+    Eval (Append s =<< Foldr (InterCalHelp s1) "" sLst)++-- helper+data InterCalHelp :: Symbol -> Symbol -> Symbol -> Exp Symbol+type instance Eval (InterCalHelp s s1 s2) = Eval (Append (Eval (Append s s1)) s2)++--------------------------------------------------------------------------------+++-- | Less-than-or-equal comparison for symbols.+-- +-- === __Example__+-- +-- >>> :kind! Eval ("b" <= "a")+-- Eval ("b" <= "a") :: Bool+-- = 'False+--+data (<=) :: Symbol -> Symbol -> Exp Bool+type instance Eval ((<=) a b) =+    Eval (Eval (TyEq (TL.CmpSymbol a b) 'LT) || Eval (TyEq (TL.CmpSymbol a b) 'EQ))++-- | Larger-than-or-equal comparison for symbols.+-- +-- === __Example__+-- +-- >>> :kind! Eval ("b" >= "a")+-- Eval ("b" >= "a") :: Bool+-- = 'True+data (>=) :: Symbol -> Symbol -> Exp Bool+type instance Eval ((>=) a b) =+    Eval (Eval (TyEq (TL.CmpSymbol a b) 'GT) || Eval (TyEq (TL.CmpSymbol a b) 'EQ))++-- | Less-than comparison for symbols.+-- +-- === __Example__+-- +-- >>> :kind! Eval ("a" < "b")+-- Eval ("a" < "b") :: Bool+-- = 'True+data (<) :: Symbol -> Symbol -> Exp Bool+type instance Eval ((<) a b) = Eval (TyEq (TL.CmpSymbol a b) 'LT)++-- | Larger-than comparison for symbols.+-- +-- === __Example__+-- +-- >>> :kind! Eval ("b" > "a")+-- Eval ("b" > "a") :: Bool+-- = 'True+data (>) :: Symbol -> Symbol -> Exp Bool+type instance Eval ((>) a b) = Eval (TyEq (TL.CmpSymbol a b) 'GT)++-- | Equality of symbols+-- +-- === __Example__+-- +-- >>> :kind! Eval ("b" == "a")+-- Eval ("b" == "a") :: Bool+-- = 'False+data (==) :: Symbol -> Symbol -> Exp Bool+type instance Eval ((==) a b) = Eval (TyEq (TL.CmpSymbol a b) 'EQ)
src/Fcf/Data/Tree.hs view
@@ -35,8 +35,7 @@ module Fcf.Data.Tree where  import           Fcf as Fcf--- import           Fcf.Data.List as Fcf -- TODO start using on fcf 0.7-import           Fcf.Alg.List as Fcf (Unfoldr,ConcatMap) -- TODO remove on fcf 0.7+import           Fcf.Data.List as Fcf  -------------------------------------------------------------------------------- @@ -66,7 +65,7 @@  -- | Unfold for a 'Tree'. ----- __Example__+-- === __Example__ --  -- >>> data BuildNode :: Nat -> Exp (Nat,[Nat]) -- >>> :{@@ -93,7 +92,7 @@  -- | Flatten a 'Tree'. ----- __Example__+-- === __Example__ --  -- >>> :kind! Eval (Flatten ('Node 1 '[ 'Node 2 '[ 'Node 3 '[ 'Node 4 '[]]], 'Node 5 '[ 'Node 6 '[]]])) -- Eval (Flatten ('Node 1 '[ 'Node 2 '[ 'Node 3 '[ 'Node 4 '[]]], 'Node 5 '[ 'Node 6 '[]]])) :: [Nat]@@ -125,7 +124,7 @@  -- | Get the levels from a 'Tree'. ----- __Example__+-- === __Example__ --  -- >>> :kind! Eval (Levels ('Node 1 '[ 'Node 2 '[ 'Node 3 '[ 'Node 4 '[]]], 'Node 5 '[ 'Node 6 '[]]])) -- Eval (Levels ('Node 1 '[ 'Node 2 '[ 'Node 3 '[ 'Node 4 '[]]], 'Node 5 '[ 'Node 6 '[]]])) :: [[Nat]]
+ test/test.hs view
@@ -0,0 +1,28 @@+{-# LANGUAGE+    DataKinds,+    KindSignatures,+    TypeOperators #-}++--------------------------------------------------------------------------------++import           Data.Type.Equality ((:~:)(Refl))+import           GHC.TypeLits (Nat)+import           Fcf++--------------------------------------------------------------------------------++import           Fcf.Data.Set++--------------------------------------------------------------------------------+++-- Compile-time tests++_ = Refl :: Eval (ToList =<< PowerSet  =<< FromList '[1,2])+        :~: '[ 'Set '[], 'Set '[2], 'Set '[1], 'Set '[1,2]]++-- Dummy++main :: IO ()+main = pure ()+