ugly.hs

module Ugly where

import           Data.List                  (sort)
import           Data.Map.Lazy              (Map, empty, insertWith, toList)

data FacetValue = FacetValue {
  value :: String,
  count :: Int
                             } deriving (Show, Eq)

instance Ord FacetValue where
  compare f1 f2 = compare (count f2) (count f1)

data FacetResponse = FacetResponse {
  status        :: String,
  values        :: [FacetValue],
  matchCount    :: Int,
  executionTime :: Int
                                   } deriving (Show, Eq)

type FacetValues = Map String Int

facetValues :: [FacetValue] -> FacetValues
facetValues [] = empty
facetValues (fv:rest) = insertWith (+) (value fv) (count fv) (facetValues rest)

unpack :: FacetValues -> [FacetValue]
unpack fv = uncurry FacetValue <$> toList fv

sanitize :: FacetResponse -> FacetResponse
sanitize (FacetResponse status values count time) = FacetResponse status (sanitizeValues values) count time
  where sanitizeValues :: [FacetValue] -> [FacetValue]
        sanitizeValues vs = sort.unpack.facetValues $ trim <$> vs
        trim :: FacetValue -> FacetValue
        trim (FacetValue key count)
          | '?' `elem` key                   = trim (FacetValue (takeWhile (/= '?') key) count)
          | (key /= []) && ('/' == last key) = FacetValue (init key) count
          | otherwise                        = FacetValue key count

sampleResponse = FacetResponse
  "ok"
  [
    FacetValue "/foo" 1,
    FacetValue "/foo/" 1,
    FacetValue "/bar" 2,
    FacetValue "/bar?baz=1" 1,
    FacetValue "/aaa" 1
  ]
  4
  1

sanitizedResponse = FacetResponse
  "ok"
  [
    FacetValue "/bar" 3,
    FacetValue "/foo" 2,
    FacetValue "/aaa" 1
  ]
  4
  1

main :: IO ()
main = do print (sanitize sampleResponse)
          if sanitize sampleResponse == sanitizedResponse
          then putStrLn "ok"
          else putStrLn "you broke it"