{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE RankNTypes #-}

module Pinboard.ApiTypesLens where

import Pinboard.ApiTypes

import Data.Text (Text)
import Data.Time (UTCTime)
import Data.Time.Calendar (Day)
import Data.Kind (Type)

import Control.Applicative
import Data.Profunctor
import Data.Either
import Prelude hiding (words, unwords)

-- * Lens Aliases
type Lens_' s a = Lens_ s s a a

type Lens_ s t a b
   = forall (f :: Type -> Type). Functor f =>
                                   (a -> f b) -> s -> f t

type Prism_' s a = Prism_ s s a a

type Prism_ s t a b
   = forall (p :: Type -> Type -> Type) (f :: Type -> Type). ( Choice p
                                                             , Applicative f
                                                             ) =>
                                                               p a (f b) -> p s (f t)
-- * Posts
postsDateL :: Lens_' Posts UTCTime
postsDateL :: (UTCTime -> f UTCTime) -> Posts -> f Posts
postsDateL UTCTime -> f UTCTime
f_acx6 (Posts UTCTime
x1_acx7 Text
x2_acx8 [Post]
x3_acx9) =
  (UTCTime -> Posts) -> f UTCTime -> f Posts
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\UTCTime
y1_acxa -> UTCTime -> Text -> [Post] -> Posts
Posts UTCTime
y1_acxa Text
x2_acx8 [Post]
x3_acx9) (UTCTime -> f UTCTime
f_acx6 UTCTime
x1_acx7)

{-# INLINE postsDateL #-}

postsPostsL :: Lens_' Posts [Post]
postsPostsL :: ([Post] -> f [Post]) -> Posts -> f Posts
postsPostsL [Post] -> f [Post]
f_acxb (Posts UTCTime
x1_acxc Text
x2_acxd [Post]
x3_acxe) =
  ([Post] -> Posts) -> f [Post] -> f Posts
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\[Post]
y1_acxf -> UTCTime -> Text -> [Post] -> Posts
Posts UTCTime
x1_acxc Text
x2_acxd [Post]
y1_acxf) ([Post] -> f [Post]
f_acxb [Post]
x3_acxe)

{-# INLINE postsPostsL #-}

postsUserL :: Lens_' Posts Text
postsUserL :: (Text -> f Text) -> Posts -> f Posts
postsUserL Text -> f Text
f_acxg (Posts UTCTime
x1_acxh Text
x2_acxi [Post]
x3_acxj) =
  (Text -> Posts) -> f Text -> f Posts
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Text
y1_acxk -> UTCTime -> Text -> [Post] -> Posts
Posts UTCTime
x1_acxh Text
y1_acxk [Post]
x3_acxj) (Text -> f Text
f_acxg Text
x2_acxi)

{-# INLINE postsUserL #-}

-- * Post
postDescriptionL :: Lens_' Post Text
postDescriptionL :: (Text -> f Text) -> Post -> f Post
postDescriptionL Text -> f Text
f_aczI (Post Text
x1_aczJ Text
x2_aczK Text
x3_aczL Text
x4_aczM Text
x5_aczN UTCTime
x6_aczO Bool
x7_aczP Bool
x8_aczQ [Text]
x9_aczR) =
  (Text -> Post) -> f Text -> f Post
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
    (\Text
y1_aczS ->
        Text
-> Text
-> Text
-> Text
-> Text
-> UTCTime
-> Bool
-> Bool
-> [Text]
-> Post
Post Text
x1_aczJ Text
y1_aczS Text
x3_aczL Text
x4_aczM Text
x5_aczN UTCTime
x6_aczO Bool
x7_aczP Bool
x8_aczQ [Text]
x9_aczR)
    (Text -> f Text
f_aczI Text
x2_aczK)

{-# INLINE postDescriptionL #-}

postExtendedL :: Lens_' Post Text
postExtendedL :: (Text -> f Text) -> Post -> f Post
postExtendedL Text -> f Text
f_aczT (Post Text
x1_aczU Text
x2_aczV Text
x3_aczW Text
x4_aczX Text
x5_aczY UTCTime
x6_aczZ Bool
x7_acA0 Bool
x8_acA1 [Text]
x9_acA2) =
  (Text -> Post) -> f Text -> f Post
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
    (\Text
y1_acA3 ->
        Text
-> Text
-> Text
-> Text
-> Text
-> UTCTime
-> Bool
-> Bool
-> [Text]
-> Post
Post Text
x1_aczU Text
x2_aczV Text
y1_acA3 Text
x4_aczX Text
x5_aczY UTCTime
x6_aczZ Bool
x7_acA0 Bool
x8_acA1 [Text]
x9_acA2)
    (Text -> f Text
f_aczT Text
x3_aczW)

{-# INLINE postExtendedL #-}

postHashL :: Lens_' Post Text
postHashL :: (Text -> f Text) -> Post -> f Post
postHashL Text -> f Text
f_acA4 (Post Text
x1_acA5 Text
x2_acA6 Text
x3_acA7 Text
x4_acA8 Text
x5_acA9 UTCTime
x6_acAa Bool
x7_acAb Bool
x8_acAc [Text]
x9_acAd) =
  (Text -> Post) -> f Text -> f Post
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
    (\Text
y1_acAe ->
        Text
-> Text
-> Text
-> Text
-> Text
-> UTCTime
-> Bool
-> Bool
-> [Text]
-> Post
Post Text
x1_acA5 Text
x2_acA6 Text
x3_acA7 Text
x4_acA8 Text
y1_acAe UTCTime
x6_acAa Bool
x7_acAb Bool
x8_acAc [Text]
x9_acAd)
    (Text -> f Text
f_acA4 Text
x5_acA9)

{-# INLINE postHashL #-}

postHrefL :: Lens_' Post Text
postHrefL :: (Text -> f Text) -> Post -> f Post
postHrefL Text -> f Text
f_acAf (Post Text
x1_acAg Text
x2_acAh Text
x3_acAi Text
x4_acAj Text
x5_acAk UTCTime
x6_acAl Bool
x7_acAm Bool
x8_acAn [Text]
x9_acAo) =
  (Text -> Post) -> f Text -> f Post
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
    (\Text
y1_acAp ->
        Text
-> Text
-> Text
-> Text
-> Text
-> UTCTime
-> Bool
-> Bool
-> [Text]
-> Post
Post Text
y1_acAp Text
x2_acAh Text
x3_acAi Text
x4_acAj Text
x5_acAk UTCTime
x6_acAl Bool
x7_acAm Bool
x8_acAn [Text]
x9_acAo)
    (Text -> f Text
f_acAf Text
x1_acAg)

{-# INLINE postHrefL #-}

postMetaL :: Lens_' Post Text
postMetaL :: (Text -> f Text) -> Post -> f Post
postMetaL Text -> f Text
f_acAq (Post Text
x1_acAr Text
x2_acAs Text
x3_acAt Text
x4_acAu Text
x5_acAv UTCTime
x6_acAw Bool
x7_acAx Bool
x8_acAy [Text]
x9_acAz) =
  (Text -> Post) -> f Text -> f Post
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
    (\Text
y1_acAA ->
        Text
-> Text
-> Text
-> Text
-> Text
-> UTCTime
-> Bool
-> Bool
-> [Text]
-> Post
Post Text
x1_acAr Text
x2_acAs Text
x3_acAt Text
y1_acAA Text
x5_acAv UTCTime
x6_acAw Bool
x7_acAx Bool
x8_acAy [Text]
x9_acAz)
    (Text -> f Text
f_acAq Text
x4_acAu)

{-# INLINE postMetaL #-}

postSharedL :: Lens_' Post Bool
postSharedL :: (Bool -> f Bool) -> Post -> f Post
postSharedL Bool -> f Bool
f_acAB (Post Text
x1_acAC Text
x2_acAD Text
x3_acAE Text
x4_acAF Text
x5_acAG UTCTime
x6_acAH Bool
x7_acAI Bool
x8_acAJ [Text]
x9_acAK) =
  (Bool -> Post) -> f Bool -> f Post
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
    (\Bool
y1_acAL ->
        Text
-> Text
-> Text
-> Text
-> Text
-> UTCTime
-> Bool
-> Bool
-> [Text]
-> Post
Post Text
x1_acAC Text
x2_acAD Text
x3_acAE Text
x4_acAF Text
x5_acAG UTCTime
x6_acAH Bool
y1_acAL Bool
x8_acAJ [Text]
x9_acAK)
    (Bool -> f Bool
f_acAB Bool
x7_acAI)

{-# INLINE postSharedL #-}

postTagsL :: Lens_' Post [Tag]
postTagsL :: ([Text] -> f [Text]) -> Post -> f Post
postTagsL [Text] -> f [Text]
f_acAM (Post Text
x1_acAN Text
x2_acAO Text
x3_acAP Text
x4_acAQ Text
x5_acAR UTCTime
x6_acAS Bool
x7_acAT Bool
x8_acAU [Text]
x9_acAV) =
  ([Text] -> Post) -> f [Text] -> f Post
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
    (\[Text]
y1_acAW ->
        Text
-> Text
-> Text
-> Text
-> Text
-> UTCTime
-> Bool
-> Bool
-> [Text]
-> Post
Post Text
x1_acAN Text
x2_acAO Text
x3_acAP Text
x4_acAQ Text
x5_acAR UTCTime
x6_acAS Bool
x7_acAT Bool
x8_acAU [Text]
y1_acAW)
    ([Text] -> f [Text]
f_acAM [Text]
x9_acAV)

{-# INLINE postTagsL #-}

postTimeL :: Lens_' Post UTCTime
postTimeL :: (UTCTime -> f UTCTime) -> Post -> f Post
postTimeL UTCTime -> f UTCTime
f_acAX (Post Text
x1_acAY Text
x2_acAZ Text
x3_acB0 Text
x4_acB1 Text
x5_acB2 UTCTime
x6_acB3 Bool
x7_acB4 Bool
x8_acB5 [Text]
x9_acB6) =
  (UTCTime -> Post) -> f UTCTime -> f Post
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
    (\UTCTime
y1_acB7 ->
        Text
-> Text
-> Text
-> Text
-> Text
-> UTCTime
-> Bool
-> Bool
-> [Text]
-> Post
Post Text
x1_acAY Text
x2_acAZ Text
x3_acB0 Text
x4_acB1 Text
x5_acB2 UTCTime
y1_acB7 Bool
x7_acB4 Bool
x8_acB5 [Text]
x9_acB6)
    (UTCTime -> f UTCTime
f_acAX UTCTime
x6_acB3)

{-# INLINE postTimeL #-}

postToReadL :: Lens_' Post Bool
postToReadL :: (Bool -> f Bool) -> Post -> f Post
postToReadL Bool -> f Bool
f_acB8 (Post Text
x1_acB9 Text
x2_acBa Text
x3_acBb Text
x4_acBc Text
x5_acBd UTCTime
x6_acBe Bool
x7_acBf Bool
x8_acBg [Text]
x9_acBh) =
  (Bool -> Post) -> f Bool -> f Post
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
    (\Bool
y1_acBi ->
        Text
-> Text
-> Text
-> Text
-> Text
-> UTCTime
-> Bool
-> Bool
-> [Text]
-> Post
Post Text
x1_acB9 Text
x2_acBa Text
x3_acBb Text
x4_acBc Text
x5_acBd UTCTime
x6_acBe Bool
x7_acBf Bool
y1_acBi [Text]
x9_acBh)
    (Bool -> f Bool
f_acB8 Bool
x8_acBg)

{-# INLINE postToReadL #-}

-- * PostDates
postDatesCountL :: Lens_' PostDates [(Day, Int)]
postDatesCountL :: ([(Day, Int)] -> f [(Day, Int)]) -> PostDates -> f PostDates
postDatesCountL [(Day, Int)] -> f [(Day, Int)]
f_a1M4D (PostDates Text
x1_a1M4E Text
x2_a1M4F [(Day, Int)]
x3_a1M4G) =
  ([(Day, Int)] -> PostDates) -> f [(Day, Int)] -> f PostDates
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\[(Day, Int)]
y1_a1M4H -> Text -> Text -> [(Day, Int)] -> PostDates
PostDates Text
x1_a1M4E Text
x2_a1M4F [(Day, Int)]
y1_a1M4H) ([(Day, Int)] -> f [(Day, Int)]
f_a1M4D [(Day, Int)]
x3_a1M4G)

{-# INLINE postDatesCountL #-}

postDatesTagL :: Lens_' PostDates Text
postDatesTagL :: (Text -> f Text) -> PostDates -> f PostDates
postDatesTagL Text -> f Text
f_a1M4I (PostDates Text
x1_a1M4J Text
x2_a1M4K [(Day, Int)]
x3_a1M4L) =
  (Text -> PostDates) -> f Text -> f PostDates
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Text
y1_a1M4M -> Text -> Text -> [(Day, Int)] -> PostDates
PostDates Text
x1_a1M4J Text
y1_a1M4M [(Day, Int)]
x3_a1M4L) (Text -> f Text
f_a1M4I Text
x2_a1M4K)

{-# INLINE postDatesTagL #-}

postDatesUserL :: Lens_' PostDates Text
postDatesUserL :: (Text -> f Text) -> PostDates -> f PostDates
postDatesUserL Text -> f Text
f_a1M4N (PostDates Text
x1_a1M4O Text
x2_a1M4P [(Day, Int)]
x3_a1M4Q) =
  (Text -> PostDates) -> f Text -> f PostDates
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Text
y1_a1M4R -> Text -> Text -> [(Day, Int)] -> PostDates
PostDates Text
y1_a1M4R Text
x2_a1M4P [(Day, Int)]
x3_a1M4Q) (Text -> f Text
f_a1M4N Text
x1_a1M4O)

{-# INLINE postDatesUserL #-}

-- * NoteList
noteListCountL :: Lens_' NoteList Int
noteListCountL :: (Int -> f Int) -> NoteList -> f NoteList
noteListCountL Int -> f Int
f_acwZ (NoteList Int
x1_acx0 [NoteListItem]
x2_acx1) =
  (Int -> NoteList) -> f Int -> f NoteList
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Int
y1_acx2 -> Int -> [NoteListItem] -> NoteList
NoteList Int
y1_acx2 [NoteListItem]
x2_acx1) (Int -> f Int
f_acwZ Int
x1_acx0)

{-# INLINE noteListCountL #-}

noteListItemsL :: Lens_' NoteList [NoteListItem]
noteListItemsL :: ([NoteListItem] -> f [NoteListItem]) -> NoteList -> f NoteList
noteListItemsL [NoteListItem] -> f [NoteListItem]
f_acx3 (NoteList Int
x1_acx4 [NoteListItem]
x2_acx5) =
  ([NoteListItem] -> NoteList) -> f [NoteListItem] -> f NoteList
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\[NoteListItem]
y1_acx6 -> Int -> [NoteListItem] -> NoteList
NoteList Int
x1_acx4 [NoteListItem]
y1_acx6) ([NoteListItem] -> f [NoteListItem]
f_acx3 [NoteListItem]
x2_acx5)

{-# INLINE noteListItemsL #-}

-- * NoteListItem
noteListItemCreatedAtL :: Lens_' NoteListItem UTCTime
noteListItemCreatedAtL :: (UTCTime -> f UTCTime) -> NoteListItem -> f NoteListItem
noteListItemCreatedAtL UTCTime -> f UTCTime
f_acx0 (NoteListItem Text
x1_acx1 Text
x2_acx2 Text
x3_acx3 Int
x4_acx4 UTCTime
x5_acx5 UTCTime
x6_acx6) =
  (UTCTime -> NoteListItem) -> f UTCTime -> f NoteListItem
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
    (\UTCTime
y1_acx7 -> Text -> Text -> Text -> Int -> UTCTime -> UTCTime -> NoteListItem
NoteListItem Text
x1_acx1 Text
x2_acx2 Text
x3_acx3 Int
x4_acx4 UTCTime
y1_acx7 UTCTime
x6_acx6)
    (UTCTime -> f UTCTime
f_acx0 UTCTime
x5_acx5)

{-# INLINE noteListItemCreatedAtL #-}

noteListItemHashL :: Lens_' NoteListItem Text
noteListItemHashL :: (Text -> f Text) -> NoteListItem -> f NoteListItem
noteListItemHashL Text -> f Text
f_acx8 (NoteListItem Text
x1_acx9 Text
x2_acxa Text
x3_acxb Int
x4_acxc UTCTime
x5_acxd UTCTime
x6_acxe) =
  (Text -> NoteListItem) -> f Text -> f NoteListItem
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
    (\Text
y1_acxf -> Text -> Text -> Text -> Int -> UTCTime -> UTCTime -> NoteListItem
NoteListItem Text
x1_acx9 Text
y1_acxf Text
x3_acxb Int
x4_acxc UTCTime
x5_acxd UTCTime
x6_acxe)
    (Text -> f Text
f_acx8 Text
x2_acxa)

{-# INLINE noteListItemHashL #-}

noteListItemIdL :: Lens_' NoteListItem Text
noteListItemIdL :: (Text -> f Text) -> NoteListItem -> f NoteListItem
noteListItemIdL Text -> f Text
f_acxg (NoteListItem Text
x1_acxh Text
x2_acxi Text
x3_acxj Int
x4_acxk UTCTime
x5_acxl UTCTime
x6_acxm) =
  (Text -> NoteListItem) -> f Text -> f NoteListItem
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
    (\Text
y1_acxn -> Text -> Text -> Text -> Int -> UTCTime -> UTCTime -> NoteListItem
NoteListItem Text
y1_acxn Text
x2_acxi Text
x3_acxj Int
x4_acxk UTCTime
x5_acxl UTCTime
x6_acxm)
    (Text -> f Text
f_acxg Text
x1_acxh)

{-# INLINE noteListItemIdL #-}

noteListItemLengthL :: Lens_' NoteListItem Int
noteListItemLengthL :: (Int -> f Int) -> NoteListItem -> f NoteListItem
noteListItemLengthL Int -> f Int
f_acxo (NoteListItem Text
x1_acxp Text
x2_acxq Text
x3_acxr Int
x4_acxs UTCTime
x5_acxt UTCTime
x6_acxu) =
  (Int -> NoteListItem) -> f Int -> f NoteListItem
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
    (\Int
y1_acxv -> Text -> Text -> Text -> Int -> UTCTime -> UTCTime -> NoteListItem
NoteListItem Text
x1_acxp Text
x2_acxq Text
x3_acxr Int
y1_acxv UTCTime
x5_acxt UTCTime
x6_acxu)
    (Int -> f Int
f_acxo Int
x4_acxs)

{-# INLINE noteListItemLengthL #-}

noteListItemTitleL :: Lens_' NoteListItem Text
noteListItemTitleL :: (Text -> f Text) -> NoteListItem -> f NoteListItem
noteListItemTitleL Text -> f Text
f_acxw (NoteListItem Text
x1_acxx Text
x2_acxy Text
x3_acxz Int
x4_acxA UTCTime
x5_acxB UTCTime
x6_acxC) =
  (Text -> NoteListItem) -> f Text -> f NoteListItem
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
    (\Text
y1_acxD -> Text -> Text -> Text -> Int -> UTCTime -> UTCTime -> NoteListItem
NoteListItem Text
x1_acxx Text
x2_acxy Text
y1_acxD Int
x4_acxA UTCTime
x5_acxB UTCTime
x6_acxC)
    (Text -> f Text
f_acxw Text
x3_acxz)

{-# INLINE noteListItemTitleL #-}

noteListItemUpdatedAtL :: Lens_' NoteListItem UTCTime
noteListItemUpdatedAtL :: (UTCTime -> f UTCTime) -> NoteListItem -> f NoteListItem
noteListItemUpdatedAtL UTCTime -> f UTCTime
f_acxE (NoteListItem Text
x1_acxF Text
x2_acxG Text
x3_acxH Int
x4_acxI UTCTime
x5_acxJ UTCTime
x6_acxK) =
  (UTCTime -> NoteListItem) -> f UTCTime -> f NoteListItem
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
    (\UTCTime
y1_acxL -> Text -> Text -> Text -> Int -> UTCTime -> UTCTime -> NoteListItem
NoteListItem Text
x1_acxF Text
x2_acxG Text
x3_acxH Int
x4_acxI UTCTime
x5_acxJ UTCTime
y1_acxL)
    (UTCTime -> f UTCTime
f_acxE UTCTime
x6_acxK)

{-# INLINE noteListItemUpdatedAtL #-}

noteCreatedAtL :: Lens_' Note UTCTime
noteCreatedAtL :: (UTCTime -> f UTCTime) -> Note -> f Note
noteCreatedAtL UTCTime -> f UTCTime
f_acx6 (Note Text
x1_acx7 Text
x2_acx8 Text
x3_acx9 Text
x4_acxa Int
x5_acxb UTCTime
x6_acxc UTCTime
x7_acxd) =
  (UTCTime -> Note) -> f UTCTime -> f Note
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
    (\UTCTime
y1_acxe -> Text -> Text -> Text -> Text -> Int -> UTCTime -> UTCTime -> Note
Note Text
x1_acx7 Text
x2_acx8 Text
x3_acx9 Text
x4_acxa Int
x5_acxb UTCTime
y1_acxe UTCTime
x7_acxd)
    (UTCTime -> f UTCTime
f_acx6 UTCTime
x6_acxc)

{-# INLINE noteCreatedAtL #-}

noteHashL :: Lens_' Note Text
noteHashL :: (Text -> f Text) -> Note -> f Note
noteHashL Text -> f Text
f_acxf (Note Text
x1_acxg Text
x2_acxh Text
x3_acxi Text
x4_acxj Int
x5_acxk UTCTime
x6_acxl UTCTime
x7_acxm) =
  (Text -> Note) -> f Text -> f Note
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
    (\Text
y1_acxn -> Text -> Text -> Text -> Text -> Int -> UTCTime -> UTCTime -> Note
Note Text
x1_acxg Text
y1_acxn Text
x3_acxi Text
x4_acxj Int
x5_acxk UTCTime
x6_acxl UTCTime
x7_acxm)
    (Text -> f Text
f_acxf Text
x2_acxh)

{-# INLINE noteHashL #-}

noteIdL :: Lens_' Note Text
noteIdL :: (Text -> f Text) -> Note -> f Note
noteIdL Text -> f Text
f_acxo (Note Text
x1_acxp Text
x2_acxq Text
x3_acxr Text
x4_acxs Int
x5_acxt UTCTime
x6_acxu UTCTime
x7_acxv) =
  (Text -> Note) -> f Text -> f Note
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
    (\Text
y1_acxw -> Text -> Text -> Text -> Text -> Int -> UTCTime -> UTCTime -> Note
Note Text
y1_acxw Text
x2_acxq Text
x3_acxr Text
x4_acxs Int
x5_acxt UTCTime
x6_acxu UTCTime
x7_acxv)
    (Text -> f Text
f_acxo Text
x1_acxp)

{-# INLINE noteIdL #-}

noteLengthL :: Lens_' Note Int
noteLengthL :: (Int -> f Int) -> Note -> f Note
noteLengthL Int -> f Int
f_acxx (Note Text
x1_acxy Text
x2_acxz Text
x3_acxA Text
x4_acxB Int
x5_acxC UTCTime
x6_acxD UTCTime
x7_acxE) =
  (Int -> Note) -> f Int -> f Note
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
    (\Int
y1_acxF -> Text -> Text -> Text -> Text -> Int -> UTCTime -> UTCTime -> Note
Note Text
x1_acxy Text
x2_acxz Text
x3_acxA Text
x4_acxB Int
y1_acxF UTCTime
x6_acxD UTCTime
x7_acxE)
    (Int -> f Int
f_acxx Int
x5_acxC)

{-# INLINE noteLengthL #-}

noteTextL :: Lens_' Note Text
noteTextL :: (Text -> f Text) -> Note -> f Note
noteTextL Text -> f Text
f_acxG (Note Text
x1_acxH Text
x2_acxI Text
x3_acxJ Text
x4_acxK Int
x5_acxL UTCTime
x6_acxM UTCTime
x7_acxN) =
  (Text -> Note) -> f Text -> f Note
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
    (\Text
y1_acxO -> Text -> Text -> Text -> Text -> Int -> UTCTime -> UTCTime -> Note
Note Text
x1_acxH Text
x2_acxI Text
x3_acxJ Text
y1_acxO Int
x5_acxL UTCTime
x6_acxM UTCTime
x7_acxN)
    (Text -> f Text
f_acxG Text
x4_acxK)

{-# INLINE noteTextL #-}

noteTitleL :: Lens_' Note Text
noteTitleL :: (Text -> f Text) -> Note -> f Note
noteTitleL Text -> f Text
f_acxP (Note Text
x1_acxQ Text
x2_acxR Text
x3_acxS Text
x4_acxT Int
x5_acxU UTCTime
x6_acxV UTCTime
x7_acxW) =
  (Text -> Note) -> f Text -> f Note
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
    (\Text
y1_acxX -> Text -> Text -> Text -> Text -> Int -> UTCTime -> UTCTime -> Note
Note Text
x1_acxQ Text
x2_acxR Text
y1_acxX Text
x4_acxT Int
x5_acxU UTCTime
x6_acxV UTCTime
x7_acxW)
    (Text -> f Text
f_acxP Text
x3_acxS)

{-# INLINE noteTitleL #-}

noteUpdatedAtL :: Lens_' Note UTCTime
noteUpdatedAtL :: (UTCTime -> f UTCTime) -> Note -> f Note
noteUpdatedAtL UTCTime -> f UTCTime
f_acxY (Note Text
x1_acxZ Text
x2_acy0 Text
x3_acy1 Text
x4_acy2 Int
x5_acy3 UTCTime
x6_acy4 UTCTime
x7_acy5) =
  (UTCTime -> Note) -> f UTCTime -> f Note
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
    (\UTCTime
y1_acy6 -> Text -> Text -> Text -> Text -> Int -> UTCTime -> UTCTime -> Note
Note Text
x1_acxZ Text
x2_acy0 Text
x3_acy1 Text
x4_acy2 Int
x5_acy3 UTCTime
x6_acy4 UTCTime
y1_acy6)
    (UTCTime -> f UTCTime
f_acxY UTCTime
x7_acy5)

{-# INLINE noteUpdatedAtL #-}

-- * Suggested (Prism)
popularP :: Prism_' Suggested [Text]
popularP :: p [Text] (f [Text]) -> p Suggested (f Suggested)
popularP =
  (Suggested -> Either Suggested [Text])
-> (Either Suggested (f [Text]) -> f Suggested)
-> p (Either Suggested [Text]) (Either Suggested (f [Text]))
-> p Suggested (f Suggested)
forall (p :: * -> * -> *) a b c d.
Profunctor p =>
(a -> b) -> (c -> d) -> p b c -> p a d
dimap
    (\Suggested
x_acHs ->
        case Suggested
x_acHs of
          (Popular [Text]
y1_acHt) -> [Text] -> Either Suggested [Text]
forall a b. b -> Either a b
Right [Text]
y1_acHt
          Suggested
_ -> Suggested -> Either Suggested [Text]
forall a b. a -> Either a b
Left Suggested
x_acHs)
    ((Suggested -> f Suggested)
-> (f [Text] -> f Suggested)
-> Either Suggested (f [Text])
-> f Suggested
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either Suggested -> f Suggested
forall (f :: * -> *) a. Applicative f => a -> f a
pure (([Text] -> Suggested) -> f [Text] -> f Suggested
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Text] -> Suggested
Popular)) (p (Either Suggested [Text]) (Either Suggested (f [Text]))
 -> p Suggested (f Suggested))
-> (p [Text] (f [Text])
    -> p (Either Suggested [Text]) (Either Suggested (f [Text])))
-> p [Text] (f [Text])
-> p Suggested (f Suggested)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
  p [Text] (f [Text])
-> p (Either Suggested [Text]) (Either Suggested (f [Text]))
forall (p :: * -> * -> *) a b c.
Choice p =>
p a b -> p (Either c a) (Either c b)
right'

{-# INLINE popularP #-}

recommendedP :: Prism_' Suggested [Text]
recommendedP :: p [Text] (f [Text]) -> p Suggested (f Suggested)
recommendedP =
  (Suggested -> Either Suggested [Text])
-> (Either Suggested (f [Text]) -> f Suggested)
-> p (Either Suggested [Text]) (Either Suggested (f [Text]))
-> p Suggested (f Suggested)
forall (p :: * -> * -> *) a b c d.
Profunctor p =>
(a -> b) -> (c -> d) -> p b c -> p a d
dimap
    (\Suggested
x_acHv ->
        case Suggested
x_acHv of
          (Recommended [Text]
y1_acHw) -> [Text] -> Either Suggested [Text]
forall a b. b -> Either a b
Right [Text]
y1_acHw
          Suggested
_ -> Suggested -> Either Suggested [Text]
forall a b. a -> Either a b
Left Suggested
x_acHv)
    ((Suggested -> f Suggested)
-> (f [Text] -> f Suggested)
-> Either Suggested (f [Text])
-> f Suggested
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either Suggested -> f Suggested
forall (f :: * -> *) a. Applicative f => a -> f a
pure (([Text] -> Suggested) -> f [Text] -> f Suggested
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Text] -> Suggested
Recommended)) (p (Either Suggested [Text]) (Either Suggested (f [Text]))
 -> p Suggested (f Suggested))
-> (p [Text] (f [Text])
    -> p (Either Suggested [Text]) (Either Suggested (f [Text])))
-> p [Text] (f [Text])
-> p Suggested (f Suggested)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
  p [Text] (f [Text])
-> p (Either Suggested [Text]) (Either Suggested (f [Text]))
forall (p :: * -> * -> *) a b c.
Choice p =>
p a b -> p (Either c a) (Either c b)
right'

{-# INLINE recommendedP #-}