# OPTIONS #

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

module Hayoo.Signature
where

import           Control.Arrow

import		 Data.List

import           Holumbus.Crawler.Util	( tokenize
					, match
					, split
					)

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

getSignature 			:: String -> String
getSignature			= split "(.*(=>|::))?(\\s)*" >>> snd

  | Strip redundant whitespace from a signature , e.g. @String - > Map k a - > Int@ will be transformed
-- to @String->Map k a->Int@.

stripSignature 			:: String -> String
stripSignature 			= tokenizeSignature >>> joinSignatureTokens

  | Normalizes a Haskell signature , e.g. @String - > Int - > Int@ will be transformed to
-- @a->b->b@. All whitespace will be removed from the resulting string.

normalizeSignature 		:: String -> String
normalizeSignature		= tokenizeSignature >>> normSignatureIds >>> joinSignatureTokens

-- | Tokenize a signature string

tokenizeSignature		:: String -> [String]
tokenizeSignature		= tokenize sigToken
    where
    sigToken			= "[\\]\\[(,)]|->|=>|\\*|" ++ sigIdent

ascSym				:: String
ascSym				= "[-!#$%&*+./<=>?@\\\\^|~]"

uniSym				:: String
uniSym				= "[\\p{S}\\p{P}-[(),;\\[\\]`{}_:'\"]]"

uniSymNoColon			:: String
uniSymNoColon			= "[\\p{S}\\p{P}-[(),;\\[\\]`{}_:'\"]]"

conSym				:: String
conSym				= ":(" ++ uniSymNoColon ++ "|" ++ uniSym ++ "{2,})"	-- somewhat tricky tricky (::) isn't a conSym

sigIdent			:: String
sigIdent			= "[\\p{L}#][\\p{L}\\{N}'_.]*"

haskIdent			:: String
haskIdent			= "[\\p{L}][\\p{L}\\{N}'_.]*"

varIdent			:: String
varIdent			= "[\\p{Ll}][\\p{L}\\{N}'_.]*"

typeIdent			:: String
  " | " + + conSym 	 -- but this requires latest  , beacuse of a parser error in uniSym expression

joinSignatureTokens		:: [String] -> String
joinSignatureTokens		= mapAccumL insBlank False >>> snd >>> concat
    where
    insBlank isId x		= (isId'
				  , if isId && isId'
				    then ' ' : x
				    else       x
				  )
	where
	isId'			= match sigIdent x

normSignatureIds		:: [String] -> [String]
normSignatureIds		= mapAccumL renId ([], ['a'..]) >>> snd
    where
    renId ac@(env, ids) x
	| isId x		= case lookup x env of
				  Nothing	-> ( ((x, head ids) : env, tail ids)
						   , [head ids]
						   )
				  Just c	-> (ac, [c])
	| otherwise		= (ac, x)
	where
	isId			= match varIdent

isSignature			:: String -> Bool
isSignature			= match $ anyWord ++ "(->|" ++ tupleType ++ "|" ++ listType ++ ")" ++ anyWord
    where
    anyWord			= "(.|\\n|\\r)*"
    listType			= "\\[" ++ anyWord ++ "\\]"
    tupleType			= "\\((" ++ anyWord ++ "," ++ anyWord ++ ")?\\)"

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

 ------------------------------------------------------------
 ------------------------------------------------------------
 to @String->Map k a->Int@.
 @a->b->b@. All whitespace will be removed from the resulting string.
 | Tokenize a signature string
 somewhat tricky tricky (::) isn't a conSym
 but this requires latest  , beacuse of a parser error in uniSym expression
 ------------------------------------------------------------
# OPTIONS #


module Hayoo.Signature
where

import           Control.Arrow

import		 Data.List

import           Holumbus.Crawler.Util	( tokenize
					, match
					, split
					)


getSignature 			:: String -> String
getSignature			= split "(.*(=>|::))?(\\s)*" >>> snd

  | Strip redundant whitespace from a signature , e.g. @String - > Map k a - > Int@ will be transformed

stripSignature 			:: String -> String
stripSignature 			= tokenizeSignature >>> joinSignatureTokens

  | Normalizes a Haskell signature , e.g. @String - > Int - > Int@ will be transformed to

normalizeSignature 		:: String -> String
normalizeSignature		= tokenizeSignature >>> normSignatureIds >>> joinSignatureTokens


tokenizeSignature		:: String -> [String]
tokenizeSignature		= tokenize sigToken
    where
    sigToken			= "[\\]\\[(,)]|->|=>|\\*|" ++ sigIdent

ascSym				:: String
ascSym				= "[-!#$%&*+./<=>?@\\\\^|~]"

uniSym				:: String
uniSym				= "[\\p{S}\\p{P}-[(),;\\[\\]`{}_:'\"]]"

uniSymNoColon			:: String
uniSymNoColon			= "[\\p{S}\\p{P}-[(),;\\[\\]`{}_:'\"]]"

conSym				:: String

sigIdent			:: String
sigIdent			= "[\\p{L}#][\\p{L}\\{N}'_.]*"

haskIdent			:: String
haskIdent			= "[\\p{L}][\\p{L}\\{N}'_.]*"

varIdent			:: String
varIdent			= "[\\p{Ll}][\\p{L}\\{N}'_.]*"

typeIdent			:: String

joinSignatureTokens		:: [String] -> String
joinSignatureTokens		= mapAccumL insBlank False >>> snd >>> concat
    where
    insBlank isId x		= (isId'
				  , if isId && isId'
				    then ' ' : x
				    else       x
				  )
	where
	isId'			= match sigIdent x

normSignatureIds		:: [String] -> [String]
normSignatureIds		= mapAccumL renId ([], ['a'..]) >>> snd
    where
    renId ac@(env, ids) x
	| isId x		= case lookup x env of
				  Nothing	-> ( ((x, head ids) : env, tail ids)
						   , [head ids]
						   )
				  Just c	-> (ac, [c])
	| otherwise		= (ac, x)
	where
	isId			= match varIdent

isSignature			:: String -> Bool
isSignature			= match $ anyWord ++ "(->|" ++ tupleType ++ "|" ++ listType ++ ")" ++ anyWord
    where
    anyWord			= "(.|\\n|\\r)*"
    listType			= "\\[" ++ anyWord ++ "\\]"
    tupleType			= "\\((" ++ anyWord ++ "," ++ anyWord ++ ")?\\)"

