-- --------------------------------------------------------------------------
--  $Revision: 262 $ $Date: 2007-04-12 12:19:50 +0200 (Thu, 12 Apr 2007) $
-- --------------------------------------------------------------------------

-- |
--
-- Module      :  PureFP.Parsers.Trie
-- Copyright   :  Peter Ljunglof 2002
-- License     :  GPL
--
-- Maintainer  :  otakar.smrz mff.cuni.cz
-- Stability   :  provisional
-- Portability :  portable
--
-- Chapters 3 and 4 of /Pure Functional Parsing – an advanced tutorial/
-- by Peter Ljunglöf
--
-- <http://www.ling.gu.se/~peb/pubs/p02-lic-thesis.pdf>
--
-- <http://www.ling.gu.se/~peb/software/functional-parsing/>


--------------------------------------------------
-- the trie parser from section 4.2.1


module PureFP.Parsers.Trie (Trie) where

import PureFP.OrdMap
import PureFP.Parsers.Parser


data Trie s a = Shift (Map s (Trie s a))  |
                a ::: Trie s a


instance Ord s => Monoid (Trie s) where
  zero                      = Shift emptyMap

  (a ::: p)  <+> q          = a ::: (p <+> q)
  p          <+> (b ::: q)  = b ::: (p <+> q)
  Shift pmap <+> Shift qmap = Shift (mergeWith (<+>) pmap qmap)


instance Ord s => Monad (Trie s) where
  return a         = a ::: zero

  (a ::: p)  >>= k = k a <+> (p >>= k)
  Shift pmap >>= k = Shift (mapMap (>>=k) pmap)


instance Ord s => Functor (Trie s) where
  fmap f p = do a <- p ; return (f a)
{--
  fmap f (a ::: p)    = f a ::: fmap f p
  fmap f (Shift pmap) = Shift (mapMap (fmap f) pmap)
--}


instance Ord s => Sequence (Trie s)


instance InputSymbol s => Symbol (Trie s) s where
  sym s = Shift (s |-> return s)
  sat p = anyof (map sym (filter p symbols))


instance Ord s => Parser (Trie s) s where
  parse (a ::: p)    inp     = (inp, a) : parse p inp
  parse _            []      = []
  parse (Shift pmap) (s:inp) = case pmap ? s of
                                 Just p  -> parse p inp
                                 Nothing -> []

  parseFull p            []      = collect p
    where collect (a:::p)        = a : collect p
          collect  _             = []
  parseFull (_ ::: p)    inp     = parseFull p inp
  parseFull (Shift pmap) (s:inp) = case pmap ? s of
                                     Just p  -> parseFull p inp
                                     Nothing -> []