type class Indexable

Indexable.hs

{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-}

module Indexable where
import qualified Data.Aeson as A
import qualified Data.HashMap.Strict as HM
import qualified Data.Map as M
import qualified Data.Vector as V
import           Data.Text (Text, unpack)
import           Data.Map (Map)
-- START this part only used to run test
import qualified Data.Attoparsec.Lazy as L
import qualified Data.ByteString.Lazy.Char8 as L
import           Data.Aeson (json')
import           Str
-- END   this part only used to run test

class Indexable a where
    type Key a
    type Value a
    (!?)  :: a -> Key a -> Maybe (Value a)
    (!) :: a -> Key a -> Value a
    x ! k = case x !? k of
        Just v -> v
        Nothing -> error "key not found"
    -- Useful for recursive data types, Valu a = a
    -- To chain lookup actions together
    (?!?) :: Maybe a -> Key a -> Maybe (Value a)
    Nothing ?!? _ = Nothing
    Just x  ?!? k = x !? k

instance Indexable [a] where
    type Key [a] = Int
    type Value [a] = a
    (!) = (!!)
    xs     !? i | i < 0 = Nothing
    []     !? _         = Nothing
    (x:_)  !? 0         = Just x
    (_:xs) !? n         = xs !? (n-1)

instance (Ord k) => Indexable (Map k v) where
    type Key (Map k v) = k
    type Value (Map k v) = v
    (!) = (M.!)
    (!?)  = flip M.lookup

instance Indexable A.Value where
    type Key (A.Value)   = Text
    type Value (A.Value) = A.Value
    x !? k = case x of
        A.Object o    -> HM.lookup k o
        A.Array  a
            | [(i, "")] <- reads (unpack k) -> a V.!? i
            | otherwise -> Nothing
        otherwise   -> Nothing

main :: IO ()
main = do
    let strMap = M.fromList [("one","1"),("two","2"),("three","3")]
    let strList = ["1","2","3"]
    let maybeJohn =  toMaybeJson jsonStr
    print $ maybeJohn ?!? "phoneNumber" ?!? "1"  -- Just (Object (fromList [("number",String "646 555-4567"),("type",String "fax")]))
    print $ strMap    !?  "two"                  -- Just "2"
    print $ strMap    !   "two"                  -- "2"
    print $ strList   !?  0                      -- Just "1"
    print $ strList   !   0                      -- "1"
    print $ strMap    !?  "no-exist"             -- Nothing
    print $ strList   !?  100                    -- Nothing
    print $ strMap    !   "no-exist"             -- error
    print $ strList   !   100                    -- error
  where
    toMaybeJson :: L.ByteString -> Maybe A.Value
    toMaybeJson = result2Maybe . L.parse json'
    result2Maybe :: L.Result a -> Maybe a
    result2Maybe (L.Done _ r) = Just r
    result2Maybe _          = Nothing
    jsonStr = [str|
{
     "firstName": "John",
     "lastName": "Smith",
     "male": true,
     "age": 25,
     "address": 
     {
         "streetAddress": "21 2nd Street",
         "city": "New York",
         "state": "NY",
         "postalCode": "10021"
     },
     "phoneNumber": 
     [
         {
           "type": "home",
           "number": "212 555-1234"
         },
         {
           "type": "fax",
           "number": "646 555-4567"
         }
     ]
 }
|]

-- Str.hs copies from http://www.haskell.org/haskellwiki/Poor_man's_here_document

for $! :: Maybe Value -> Text -> Maybe Value, so maybeJohn $! "phoneNumber" $! "1"

"1" cannot be type checked, need to be improved.

Will GADT help?

What is Dependent Type?