lensy-db.hs

{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE PartialTypeSignatures #-}
{-# LANGUAGE NoMonomorphismRestriction #-}
module Lensy where

import Data.Functor.Identity
import Control.Lens

data Api f 
    = Api 
    { _users :: f [User f]
    , _photos :: f [Photo f]
    } 

data User f
    = User
    { _name :: f String
    , _follows :: f [User f]
    }

data Photo f
    = Photo
    { _url :: f String
    , _tags :: f [String]
    }

makeLenses ''Api
makeLenses ''User
makeLenses ''Photo

matt :: Applicative f => User f
matt = User (pure "Matt") (pure [bar])

user :: Applicative f => String -> [User f] -> User f
user a b = User (pure a) (pure b)

foo :: Applicative f => User f
foo = user "Foo" [matt, bar]

bar :: Applicative f => User f
bar = user "Bar" [foo, matt]

photo :: Applicative f => String -> [String] -> Photo f
photo a b = Photo (pure a) (pure b)

testPhotos :: Applicative f => [Photo f]
testPhotos =
    [ photo "cats.jpg" ["cute", "adorbs"]
    , photo "sloths.png" ["lol", "wat"]
    ]

api :: Applicative f => [User f] -> [Photo f] -> Api f
api a b = Api (pure a) (pure b)

testApi :: Applicative f => Api f
testApi = Api (pure [matt, foo, bar]) (pure testPhotos)

-- ok, so  now we have an API. how can we query it?
a :: Api Identity
a = testApi

exPhotos :: Identity [Photo Identity]
exPhotos = view photos a

exUrls :: Identity [Identity String]
exUrls = toListOf (each . url) <$> view photos a

justUrls :: [String]
justUrls = runIdentity $ exUrls >>= sequence

justUrlsF :: Monad m => m [String]
justUrlsF = sequence =<< toListOf (each . url) <$> view photos testApi

-- Several layers of nesting gets really unwieldy.
exTags :: Applicative f => f [f [String]]
exTags = toListOf (each . tags) <$> view photos testApi

justTags :: Monad m => m [String]
justTags =
    fmap concat . sequence =<< toListOf (each.tags) <$> view photos testApi

-- The equivalent without the intermediate structure is:
data Api' = Api' { _users' :: [User'], _photos' :: [Photo'] } deriving Show
data User' = User' { _name' :: String, _follows' :: [User'] } deriving Show
data Photo' = Photo' { _url' :: String, _tags' :: [String] } deriving Show

makeLenses ''Api'
makeLenses ''User'
makeLenses ''Photo'

simpleApi :: Api'
simpleApi = Api' [User' "asdf" [User' "for" []]] [Photo' "qwer" ["asdf", "qwer", "wert"]]

justTags' :: [String]
justTags' = simpleApi ^. photos' . traversed . tags'

justTags'' :: (Applicative f, Traversable f) => [f [String]]
justTags'' = testApi ^.. photos . traversed . each . tags

followsNames' :: [String]
followsNames' = simpleApi ^.. users' . each . follows' . each . name'

followsNames :: (Applicative f, Traversable f) => [f String]
followsNames = testApi ^.. users . traversed . each . follows . traversed . each . name

-- Now if I had some Traversable database type...