{-# LANGUAGE FlexibleContexts, Safe #-}

{-|
Module      : Text.Parse.Trie
Description : A module to convert Strings to a trie-based parser.
Maintainer  : hapytexeu+gh@gmail.com
Stability   : experimental
Portability : POSIX

A module to convert Strings to a trie-based parser.
-}

module Text.Parse.Trie (
    parseTrie
  ) where

import Control.Applicative((<|>))
import Control.Arrow(first)

import Data.List(sortOn)
import Data.List.Group(groupWith)
import Data.List.NonEmpty(NonEmpty((:|)))

import Text.Parsec(ParsecT, Stream, parserReturn, parserZero)
import Text.Parsec.Char(char)

_chomp :: [a] -> [a]
_chomp :: [a] -> [a]
_chomp [] = []
_chomp ~(_:xs :: [a]
xs) = [a]
xs

_neToList :: NonEmpty a -> [a]
_neToList :: NonEmpty a -> [a]
_neToList (a :: a
a :| as :: [a]
as) = a
a a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
as

-- | Convert the given list of 2-tuples with a string to a trie-like parser.
parseTrie :: Stream s m Char
  => [(String, a)]  -- ^ The list of 2-tuples to convert to a trie-like parser.
  -> ParsecT s u m a  -- ^ The corresponding trie-like parser
parseTrie :: [(String, a)] -> ParsecT s u m a
parseTrie = [(String, a)] -> ParsecT s u m a
forall s (m :: * -> *) a u.
Stream s m Char =>
[(String, a)] -> ParsecT s u m a
_parseTrie ([(String, a)] -> ParsecT s u m a)
-> ([(String, a)] -> [(String, a)])
-> [(String, a)]
-> ParsecT s u m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((String, a) -> String) -> [(String, a)] -> [(String, a)]
forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn (String, a) -> String
forall a b. (a, b) -> a
fst

_parseTrie :: Stream s m Char => [(String, a)] -> ParsecT s u m a
_parseTrie :: [(String, a)] -> ParsecT s u m a
_parseTrie [] = ParsecT s u m a
forall s u (m :: * -> *) a. ParsecT s u m a
parserZero
_parseTrie (("", x :: a
x) : ss :: [(String, a)]
ss) = [(String, a)] -> ParsecT s u m a
forall s (m :: * -> *) a u.
Stream s m Char =>
[(String, a)] -> ParsecT s u m a
_parseTrieRem [(String, a)]
ss ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> a -> ParsecT s u m a
forall a s u (m :: * -> *). a -> ParsecT s u m a
parserReturn a
x
_parseTrie ss :: [(String, a)]
ss = [(String, a)] -> ParsecT s u m a
forall s (m :: * -> *) a u.
Stream s m Char =>
[(String, a)] -> ParsecT s u m a
_parseTrieRem [(String, a)]
ss

_parseTrieLeg :: Stream s m Char => Char -> NonEmpty (String, a) -> ParsecT s u m a
_parseTrieLeg :: Char -> NonEmpty (String, a) -> ParsecT s u m a
_parseTrieLeg c :: Char
c is :: NonEmpty (String, a)
is = Char -> ParsecT s u m Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
c ParsecT s u m Char -> ParsecT s u m a -> ParsecT s u m a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> [(String, a)] -> ParsecT s u m a
forall s (m :: * -> *) a u.
Stream s m Char =>
[(String, a)] -> ParsecT s u m a
_parseTrie (((String, a) -> (String, a)) -> [(String, a)] -> [(String, a)]
forall a b. (a -> b) -> [a] -> [b]
map ((String -> String) -> (String, a) -> (String, a)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first String -> String
forall a. [a] -> [a]
_chomp) (NonEmpty (String, a) -> [(String, a)]
forall a. NonEmpty a -> [a]
_neToList NonEmpty (String, a)
is))

_parseTrieRem :: Stream s m Char => [(String, a)] -> ParsecT s u m a
_parseTrieRem :: [(String, a)] -> ParsecT s u m a
_parseTrieRem = ((Char, NonEmpty (String, a))
 -> ParsecT s u m a -> ParsecT s u m a)
-> ParsecT s u m a
-> [(Char, NonEmpty (String, a))]
-> ParsecT s u m a
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
(<|>) (ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a)
-> ((Char, NonEmpty (String, a)) -> ParsecT s u m a)
-> (Char, NonEmpty (String, a))
-> ParsecT s u m a
-> ParsecT s u m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> NonEmpty (String, a) -> ParsecT s u m a)
-> (Char, NonEmpty (String, a)) -> ParsecT s u m a
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Char -> NonEmpty (String, a) -> ParsecT s u m a
forall s (m :: * -> *) a u.
Stream s m Char =>
Char -> NonEmpty (String, a) -> ParsecT s u m a
_parseTrieLeg) ParsecT s u m a
forall s u (m :: * -> *) a. ParsecT s u m a
parserZero ([(Char, NonEmpty (String, a))] -> ParsecT s u m a)
-> ([(String, a)] -> [(Char, NonEmpty (String, a))])
-> [(String, a)]
-> ParsecT s u m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((String, a) -> Char)
-> [(String, a)] -> [(Char, NonEmpty (String, a))]
forall b a. Eq b => (a -> b) -> [a] -> [(b, NonEmpty a)]
groupWith (String -> Char
forall a. [a] -> a
head (String -> Char) -> ((String, a) -> String) -> (String, a) -> Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String, a) -> String
forall a b. (a, b) -> a
fst)