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 +12/−1
- default.nix +16/−6
- examples/Orbits.hs +1/−1
- fcf-containers.cabal +14/−11
- src/Fcf/Alg/List.hs +37/−57
- src/Fcf/Alg/Morphism.hs +4/−4
- src/Fcf/Data/MapC.hs +126/−94
- src/Fcf/Data/Set.hs +139/−29
- src/Fcf/Data/Symbol.hs +152/−0
- src/Fcf/Data/Tree.hs +4/−5
- test/test.hs +28/−0
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 ()+