Utils.hs

{-# OPTIONS -Wall #-}

--------------------------------------------------------------------------------
-- |
-- Module      :  Hurdle.Utils
-- Copyright   :  (c) Stephen Tetley 2009
-- License     :  BSD3
--
-- Maintainer  :  Stephen Tetley <stephen.tetley@gmail.com>
-- Stability   :  highly unstable
-- Portability :  to be determined.
--
-- 
--
--------------------------------------------------------------------------------

module Hurdle.Utils 
  (
    module Data.ParserCombinators.KangarooWriter
  , Parser
  , H
  , toList
  , logline
  , logPosition

  , stringTruncate
  ) where


import Data.ParserCombinators.KangarooWriter

import Data.Monoid

type Parser a = Kangaroo (H Char) a    


-- Hughes list - same as DList but we don't want a dependency

newtype H a = H { unH :: [a] -> [a] }

fromList :: [a] -> H a
fromList xs = H (xs++)

toList :: H a -> [a]
toList f = unH f []

append :: H a -> H a -> H a
append f g = H $ unH f . unH g

charH :: Char -> H Char
charH = fromList . return 

stringH :: String -> H Char
stringH = fromList

instance Monoid (H a) where
  mempty = fromList []
  mappend = append

logline :: String -> Parser ()
logline s = tell $ stringH s `append` charH '\n'


logPosition :: String -> Parser ()
logPosition s = position >>= \pos -> 
    logline $ s ++ ", position " ++ show pos


--------------------------------------------------------------------------------

stringTruncate :: String -> String
stringTruncate = takeWhile (/= '\NUL')