├── .gitignore ├── LICENSE ├── README.md ├── Setup.hs ├── regex-type.cabal └── src └── Data └── Type ├── Regex.hs └── Regex └── ListUtils.hs /.gitignore: -------------------------------------------------------------------------------- 1 | tags 2 | dist 3 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | Copyright (c) 2016, Csongor Kiss 2 | 3 | All rights reserved. 4 | 5 | Redistribution and use in source and binary forms, with or without 6 | modification, are permitted provided that the following conditions are met: 7 | 8 | * Redistributions of source code must retain the above copyright 9 | notice, this list of conditions and the following disclaimer. 10 | 11 | * Redistributions in binary form must reproduce the above 12 | copyright notice, this list of conditions and the following 13 | disclaimer in the documentation and/or other materials provided 14 | with the distribution. 15 | 16 | * Neither the name of Csongor Kiss nor the names of other 17 | contributors may be used to endorse or promote products derived 18 | from this software without specific prior written permission. 19 | 20 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 21 | "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 22 | LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR 23 | A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT 24 | OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, 25 | SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT 26 | LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, 27 | DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY 28 | THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT 29 | (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE 30 | OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 31 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # regex-type 2 | Regular expression matching of Haskell types using nondeterministic finite automata 3 | 4 | *This is a playground for writing type-level code using TypeFamilies.* 5 | 6 | Available on [hackage](http://hackage.haskell.org/package/regex-type) 7 | 8 | Some examples that work: 9 | 10 | ```haskell 11 | -- encode the following regex: (Int | Char | (Bool -> Bool)) (String | (Int -> Bool)) 12 | regex :: ('[a, b] ~= ((Int :| Char :| (Bool -> Bool)) :> (String :| (Int -> Bool)))) => a -> b 13 | regex = undefined 14 | 15 | -- The type of these functions all match the regular expression defined in the type of regex 16 | -- so they all typecheck 17 | test1 :: Int -> String 18 | test1 = regex 19 | 20 | test2 :: Int -> Int -> Bool 21 | test2 = regex 22 | 23 | test3 :: Char -> String 24 | test3 = regex 25 | 26 | test4 :: Char -> Int -> Bool 27 | test4 = regex 28 | 29 | test5 :: (Bool -> Bool) -> Int -> Bool 30 | test5 = regex 31 | 32 | test6 :: (Bool -> Bool) -> String 33 | test6 = regex 34 | 35 | -- This doesn't satisfy the regex, and thus a type error occurs 36 | test_wrong :: Int -> Bool 37 | test_wrong = regex 38 | 39 | 40 | -- Doesn't typecheck because the list doesn't satisfy the (Int*) regex. 41 | test_wrong2 :: ('[Int, Int, Int, Int, Char] ~= (Rep Int)) => a -> a 42 | test_wrong2 = id 43 | 44 | -- test7 can only be called with a ~ Int 45 | test7 :: ('[Int, Int, Int, Int, a] ~= (Rep Int)) => a -> a 46 | test7 = id 47 | ``` 48 | 49 | # TODO: 50 | - Improve performance 51 | - Try converting the NFA to a DFA. I don't know if this will make it faster overall, as I suspect the automaton is reconstructed every time, which means an exponential complexity on each check with the DFA. Maybe an on-demand construction? 52 | - Figure out if it's actually useful for anything 53 | -------------------------------------------------------------------------------- /Setup.hs: -------------------------------------------------------------------------------- 1 | import Distribution.Simple 2 | main = defaultMain 3 | -------------------------------------------------------------------------------- /regex-type.cabal: -------------------------------------------------------------------------------- 1 | -- Initial regex-type.cabal generated by cabal init. For further 2 | -- documentation, see http://haskell.org/cabal/users-guide/ 3 | 4 | -- The name of the package. 5 | name: regex-type 6 | 7 | -- The package version. See the Haskell package versioning policy (PVP) 8 | -- for standards guiding when and how versions should be incremented. 9 | -- http://www.haskell.org/haskellwiki/Package_versioning_policy 10 | -- PVP summary: +-+------- breaking API changes 11 | -- | | +----- non-breaking API additions 12 | -- | | | +--- code changes with no API change 13 | version: 0.1.0.0 14 | 15 | -- A short (one-line) description of the package. 16 | synopsis: Type-level regular expressions 17 | 18 | -- A longer description of the package. 19 | description: Regular expression matching of Haskell types using nondeterministic finite automata. 20 | 21 | -- URL for the project homepage or repository. 22 | homepage: https://github.com/kcsongor/regex-type 23 | 24 | -- The license under which the package is released. 25 | license: BSD3 26 | 27 | -- The file containing the license text. 28 | license-file: LICENSE 29 | 30 | -- The package author(s). 31 | author: Csongor Kiss 32 | 33 | -- An email address to which users can send suggestions, bug reports, and 34 | -- patches. 35 | maintainer: kiss.csongor.kiss@gmail.com 36 | 37 | -- A copyright notice. 38 | -- copyright: 39 | 40 | category: Data 41 | 42 | build-type: Simple 43 | 44 | -- Extra files to be distributed with the package, such as examples or a 45 | -- README. 46 | extra-source-files: README.md 47 | 48 | -- Constraint on the version of Cabal needed to build this package. 49 | cabal-version: >=1.10 50 | 51 | 52 | library 53 | -- Modules exported by the library. 54 | exposed-modules: Data.Type.Regex Data.Type.Regex.ListUtils 55 | 56 | -- Modules included in this library but not exported. 57 | -- other-modules: 58 | 59 | -- LANGUAGE extensions used by modules in this package. 60 | other-extensions: TypeFamilies, PolyKinds, DataKinds, TypeOperators, UndecidableInstances, ExistentialQuantification, MultiParamTypeClasses, FlexibleInstances, FlexibleContexts 61 | 62 | -- Other library packages from which modules are imported. 63 | build-depends: base >=4.8 && <= 4.9 64 | 65 | -- Directories containing source files. 66 | hs-source-dirs: src 67 | 68 | -- Base language which the package is written in. 69 | default-language: Haskell2010 70 | 71 | source-repository head 72 | type: git 73 | location: https://github.com/kcsongor/regex-type 74 | -------------------------------------------------------------------------------- /src/Data/Type/Regex.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE TypeFamilies #-} 2 | {-# LANGUAGE PolyKinds #-} 3 | {-# LANGUAGE DataKinds #-} 4 | {-# LANGUAGE TypeOperators #-} 5 | {-# LANGUAGE UndecidableInstances #-} 6 | {-# LANGUAGE ExistentialQuantification #-} 7 | {-# LANGUAGE MultiParamTypeClasses #-} 8 | {-# LANGUAGE FlexibleInstances #-} 9 | {-# LANGUAGE FlexibleContexts #-} 10 | 11 | module Data.Type.Regex 12 | ( 13 | type (~=) 14 | , type (:|) 15 | , type (:>) 16 | , type Rep 17 | , type Opt 18 | , type Plus 19 | , type Null 20 | ) where 21 | 22 | import Data.Type.Bool 23 | import GHC.TypeLits 24 | import Data.Type.Regex.ListUtils 25 | 26 | -- Matching 27 | class input ~= re 28 | instance (Accepts (MakeNDA re) input ~ 'True) => input ~= re 29 | 30 | type family ToTerm (a :: k) :: RE where 31 | ToTerm (a :: *) = 'Term a 32 | ToTerm (a :: RE) = a 33 | 34 | type a :| b = 'Alt (ToTerm a) (ToTerm b) 35 | type a :> b = 'Seq (ToTerm a) (ToTerm b) 36 | type Rep a = 'Rep (ToTerm a) 37 | type Opt a = 'Alt (ToTerm a) 'Null 38 | type Plus a = 'Seq (ToTerm a) ('Rep (ToTerm a)) 39 | type Null = 'Null 40 | 41 | -- PRIVATE: 42 | data RE 43 | = Null 44 | | forall (c :: *). Term c 45 | | Seq RE RE 46 | | Alt RE RE 47 | | Rep RE 48 | 49 | data Label 50 | = forall (c :: *). C c 51 | | Eps 52 | 53 | -- check if nda accepts input 54 | type family Accepts (automaton :: (Nat, [Nat], [(Nat, Nat, Label)])) (input :: [*]) :: Bool where 55 | Accepts '(start, terminals, ts) i 56 | = Accepts' start '(start, terminals, ts) i 57 | 58 | type family Accepts' (state :: Nat) (automaton :: (Nat, [Nat], [(Nat, Nat, Label)])) (input :: [*]) :: Bool where 59 | Accepts' start a input 60 | = (IsTerminal start a && IsNull input) 61 | || AnyAccepted input a (TransitionsFromTo start (AllTransitions a)) 62 | 63 | type family IsTerminal state automaton :: Bool where 64 | IsTerminal s '(start, terminals, ts) 65 | = Elem s terminals 66 | 67 | type family TransitionsFromTo state (ts :: [(Nat, Nat, Label)]) :: [(Nat, Nat, Label)] where 68 | TransitionsFromTo state '[] = '[] 69 | TransitionsFromTo state ('(state, to, label) ': ts) 70 | = '(state, to, label) ': TransitionsFromTo state ts 71 | TransitionsFromTo state (t ': ts) 72 | = TransitionsFromTo state ts 73 | 74 | type family AllTransitions automaton :: [(Nat, Nat, Label)] where 75 | AllTransitions '(start, term, all) 76 | = all 77 | 78 | type family LabelsOf (ts :: [(Nat, Nat, Label)]) :: [Label] where 79 | LabelsOf ts 80 | = Nub (FilterOut 'Eps (LabelsOf' ts)) 81 | 82 | type family LabelsOf' (ts :: [(Nat, Nat, Label)]) :: [Label] where 83 | LabelsOf' '[] 84 | = '[] 85 | LabelsOf' ('(from, to, label) ': ts) 86 | = label ': LabelsOf' ts 87 | 88 | type family AnyAccepted input automaton transitions :: Bool where 89 | AnyAccepted i a '[] 90 | = 'False 91 | AnyAccepted i a (t ': ts) 92 | = Try i a t || AnyAccepted i a ts 93 | 94 | type family Try input automaton transition :: Bool where 95 | Try input a '(from, to, 'Eps) 96 | = Accepts' to a input 97 | Try (h ': rest) a '(from, to, 'C h) 98 | = Accepts' to a rest 99 | Try i a t 100 | = 'False 101 | 102 | -- Make NDA 103 | 104 | type family Fst (tuple :: (a, b)) :: a where 105 | Fst '(a, b) = a 106 | 107 | type family Snd (tuple :: (a, b)) :: b where 108 | Snd '(a, b) = b 109 | 110 | type family MakeNDA (re :: RE) :: (Nat, [Nat], [(Nat, Nat, Label)]) where 111 | MakeNDA re 112 | = '(1, '[2], Fst (Make re 1 2 3)) 113 | 114 | type family Make (re :: RE) (m :: Nat) (n :: Nat) (k :: Nat) :: ([(Nat, Nat, Label)], Nat) where 115 | Make 'Null m n k 116 | = '( '[ '(m, n, 'Eps)], k) 117 | Make ('Term c) m n k 118 | = '( '[ '(m, n, 'C c)], k) 119 | Make ('Seq re1 re2) m n k 120 | = Make re1 m k (k + 2) 121 | `BindMake` '(re2, (k + 1), n) 122 | `BindMake` '( 'Null, k, (k + 1)) 123 | Make ('Alt re1 re2) m n k 124 | = Make re1 k (k + 1) (k + 4) 125 | `BindMake` '(re2, (k + 2), (k + 3)) 126 | `Comb1` Make 'Null m k (k + 1) 127 | `Comb1` Make 'Null m (k + 2) (k + 3) 128 | `Comb1` Make 'Null (k + 1) n n 129 | `Comb1` Make 'Null (k + 3) n n 130 | Make ('Rep re) m n k 131 | = Make re k (k + 1) (k + 2) 132 | `Comb1` Make 'Null m k k 133 | `Comb1` Make 'Null (k + 1) k k 134 | `Comb1` Make 'Null (k + 1) n n 135 | `Comb1` Make 'Null m n n 136 | 137 | type family BindMake (ma :: ([(Nat, Nat, Label)], Nat)) (mba :: (RE, Nat, Nat)) :: ([(Nat, Nat, Label)], Nat) where 138 | BindMake '(ts1, k1) '(re, m, n) 139 | = Comb2 '(ts1, k1) (Make re m n k1) 140 | 141 | type family Comb1 (a :: ([t], k1)) (b :: ([t], k2)) :: ([t], k1) where 142 | Comb1 '(ts1, k1) '(ts2, k2) 143 | = '(ts1 ++ ts2, k1) 144 | 145 | type family Comb2 (a :: ([t], k1)) (b :: ([t], k2)) :: ([t], k2) where 146 | Comb2 '(ts1, k1) '(ts2, k2) 147 | = '(ts1 ++ ts2, k2) 148 | -------------------------------------------------------------------------------- /src/Data/Type/Regex/ListUtils.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE TypeFamilies #-} 2 | {-# LANGUAGE PolyKinds #-} 3 | {-# LANGUAGE DataKinds #-} 4 | {-# LANGUAGE TypeOperators #-} 5 | {-# LANGUAGE UndecidableInstances #-} 6 | module Data.Type.Regex.ListUtils 7 | ( 8 | type Nub 9 | , type IsNull 10 | , type FilterOut 11 | , type Elem 12 | , type (++) 13 | ) where 14 | 15 | -- |Nub elements O(n^2) 16 | type family Nub (xs :: [k]) :: [k] where 17 | Nub '[] = '[] 18 | Nub (x ': xs) = x ': Nub (FilterOut x xs) 19 | 20 | type family IsNull xs where 21 | IsNull '[] = 'True 22 | IsNull xs = 'False 23 | 24 | -- FilterOut x xs ~~ filter (/= x) xs 25 | type family FilterOut (x :: k) (xs :: [k]) :: [k] where 26 | FilterOut x '[] = '[] 27 | FilterOut x (x ': xs) = FilterOut x xs 28 | FilterOut x (y ': xs) = y ': FilterOut x xs 29 | 30 | type family Elem (x :: k) (xs :: [k]) where 31 | Elem x '[] = 'False 32 | Elem x (x ': xs) = 'True 33 | Elem x (y ': xs) = Elem x xs 34 | 35 | type family xs ++ ys where 36 | '[] ++ ys = ys 37 | (x ': xs) ++ ys = x ': (xs ++ ys) 38 | --------------------------------------------------------------------------------