content: {-# LANGUAGE FlexibleContexts #-}
  {-# LANGUAGE RankNTypes #-}
  {-# LANGUAGE TemplateHaskell #-}
  {-# LANGUAGE ViewPatterns #-}
  
  {-# OPTIONS_GHC -Wno-type-defaults #-}
  {-# OPTIONS_GHC -Wno-unused-imports #-}
  {-# OPTIONS_GHC -Wno-unused-top-binds #-}
  
  module Main ( Record, HasRecord(..)
              , digits
              , main
              ) where
  
  import           Control.Exception
  import           Control.Lens
  import           Control.Monad.State
  import           Data.Char
  import           Data.Data
  import           Data.Data.Lens
  import           Data.Function
  import           Data.List
  import           Data.Maybe (isJust)
  import           Data.Map (Map)
  import qualified Data.Map as M
  import           Data.Monoid
  import           Data.Set (Set)
  import qualified Data.Set as S
  import           Test.Hspec
  
  default (Int)
  
  data Record = Record
    { _field1 :: Int
    , _field2 :: Int
    }
    deriving (Eq, Show)
  
  makeClassy ''Record
  
  data ADT = Alpha Int Int
           | Beta Record
           | Gamma String
    deriving (Eq, Show)
  
  makePrisms ''ADT
  
  digits :: Iso' Int [Int]
  digits =
    iso (map (read :: String -> Int) . sequence . (:[]) . show)
        ((read :: String -> Int) . concatMap show)
  
  my_1 :: Lens' (Integer, Integer) Int
  my_1 f (p1, p2) =
    (\n -> (toInteger n, p2)) <$> f (fromIntegral p1)
  
  my_1' :: Functor f
        => (Int -> f Int)
        -> (Integer, Integer)
        -> f (Integer, Integer)
  my_1' f (p1, p2) =
    (\n -> (toInteger n, p2)) <$> f (fromIntegral p1)
  
  newtype Bar = Bar
    { _baz :: Int
    } deriving (Eq, Show)
  makeLenses ''Bar
  
  newtype Foo = Foo
    { _bar :: Bar
    } deriving (Eq, Show)
  makeLenses ''Foo
  
  newtype Top = Top
    { _foo :: Foo
    } deriving (Eq, Show)
  makeLenses ''Top
  
  foobar :: Traversal [a] (Maybe [a]) a (Maybe a)
  foobar f xs = fmap sequence (xs & traverse %%~ f)
  
  example :: (a -> Maybe a) -> [a] -> Maybe [a]
  example f xs = xs & partsOf (traversed.filtered (isJust . f))._head %%~ f
  
  {-----------------------------------------------------------------------------}
  
  infixr 0 ==>
  (==>) :: (HasCallStack, Show a, Eq a) => a -> a -> Expectation
  (==>) = shouldBe
  
  infixr 0 /=>
  (/=>) :: (HasCallStack, Show a, Eq a) => a -> a -> Expectation
  (/=>) = shouldNotBe
  
  infixr 0 !!>
  (!!>) :: (HasCallStack, Exception e) => a -> Selector e -> Expectation
  v !!> s = pure v `shouldThrow` s
  
  bag :: Ord a => [a] -> Set a
  bag = S.fromList
  
  alist :: Ord k => [(k, a)] -> Map k a
  alist = M.fromList
  
  {-----------------------------------------------------------------------------}
  
  main :: IO ()
  main = hspec $ parallel $ do
    describe "Lens" $ do
      describe "Tuple" $ do
        describe "view" $ do
          it "operator" $
            (1,2,3) ^. _2
              ==> 2
  
          it "function" $
            view _2 (1,2,3)
              ==> 2
  
        describe "set" $ do
          it "operator" $
            (1,2,3) & _2 .~ 20
              ==> (1,20,3)
  
          it "function" $
            set _2 20 (1,2,3)
              ==> (1,20,3)
  
        it "both" $
          (1,2) ^.. both
            ==> [1,2]
  
        it "each" $
          (1,2,3) ^.. each
            ==> [1,2,3]
  
        it "alongside" $
          ((1,2), (3,4)) ^. alongside _2 _1
            ==> (2,3)
  
      describe "records" $ do
        it "view" $
          Record 20 30 ^. field1
            ==> 20
  
        it "set" $
          Record 20 30 & field1 .~ 1
            ==> Record 1 30
  
        it "over" $
          Record 20 30 & field1 %~ mod 5
            ==> Record 5 30
  
        it "overA" $
          Record 20 30 & field1
            %%~ (pure :: a -> Identity a)
            ==> pure (Record 20 30)
  
        it "matches" $
          let v = Top (Foo (Bar 100)) in
          v & foo.bar.baz +~ 1
            ==> let f = _foo v
                    b = _bar f
                    z = _baz b in
                v { _foo = f {
                      _bar = b {
                        _baz = z + 1 } } }
  
      describe "Wrapped" $ do
        it "view" $
          Sum 5 ^. _Wrapped
            ==> 5
  
        it "set" $
          Sum 5 & _Wrapped +~ 10
            ==> Sum 15
  
        it "over" $
          Sum 30 & _Wrapped %~ (+10)
            ==> Sum 40
  
      describe "custom" $ do
        it "my_1" $
          (100, 200) ^. my_1
            ==> 100
  
        it "my_1-fails" $
          (10000000000000000000000000000000000, 200)
            ^. my_1
            ==> 4003012203950112768
  
        it "my_1'" $
          (100, 200) ^. my_1'
            ==> 100
  
    describe "Prism" $ do
      describe "Either" $ do
        describe "preview" $ do
          it "present" $
            Left 10 ^? _Left
              ==> Just 10
  
          it "absent" $
            (Right 10 :: Either Int Int) ^? _Left
              ==> Nothing
  
        describe "setter" $ do
          it "present" $
            (Left 10 :: Either Int Int) & _Left .~ 2
              ==> Left 2
  
          it "absent" $
            (Left 10 :: Either Int Int) & _Right .~ 2
              ==> Left 10
  
        describe "over" $ do
          it "present" $
            (Left 10 :: Either Int Int)
              & _Left %~ even
              ==> Left True
  
          it "absent" $
            (Left 10 :: Either Int Int)
              & _Right %~ even
              ==> Left 10
  
          it "failover" $
            (Left 10 :: Either Int Int)
              & failover _Right even
              ==> (mzero :: Maybe (Either Int Bool))
  
        it "has" $
          has _Left (Left 5)
            ==> True
  
        it "isn't" $
          isn't _Right (Left 5)
            ==> True
  
        it "review" $
          _Alpha # (30,40)
            ==> Alpha 30 40
  
        it "matches" $
          let v = Beta (Record 10 20) in
          v & _Beta.field1 +~ 1
            ==> case v of
              Beta z ->
                Beta (z { _field1 = _field1 z + 1 })
              _ -> v
  
      describe "ADTs" $ do
        describe "preview" $ do
          it "present" $
            Alpha 10 20 ^? _Alpha._2
              ==> Just 20
  
          it "absent" $
            Gamma "hello" ^? _Alpha._2
              ==> Nothing
  
        describe "setter" $ do
          it "present" $
            Alpha 10 20 & _Alpha._2 .~ 2
              ==> Alpha 10 2
  
          it "absent" $
            Alpha 10 20 & _Beta.field1 .~ 2
              ==> Alpha 10 20
  
        it "has" $
          has _Beta (Alpha 1 2)
            ==> False
  
        it "review" $
          _Alpha # (30,40)
            ==> Alpha 30 40
  
    describe "Traversal" $ do
      describe "List" $ do
        it "toListOf" $
          [1,2,3,4] ^.. traverse
            ==> [1,2,3,4]
  
        it "allOf" $
          allOf (traverse._2) even
            [(1, 10), (2, 12)]
            ==> True
  
        it "monoid" $
          [1,2,3,4] ^. traverse.to Sum
            ==> Sum 10
  
        it "preview" $
          [1,2,3] ^? ix 1
            ==> Just 2
  
        it "has" $
          has (ix 1) [1,2,3]
            ==> True
  
        it "set" $
          [1,2,3] & ix 1 .~ 20
            ==> [1,20,3]
  
        describe "only" $ do
          it "success" $
            5 ^? only 5
              ==> Just ()
  
          it "failure" $
            5 ^? only 4
              ==> Nothing
  
          it "has-filtered" $
            has (traverse.filtered (== 5)) [1,2,3,4]
              ==> False
  
          it "has-only" $
            has (traverse.only 5) [1,2,3,4]
              ==> False
  
        describe "singular" $ do
          it "_head-alone" $
            [1,2,3] ^? _head
              ==> Just 1
  
          it "_head" $
            [1,2,3] ^. singular _head
              ==> 1
  
      describe "Set" $
        describe "contains" $ do
          it "view" $
            bag [1, 2, 3] ^. contains 2
              ==> True
  
          it "set" $
            bag [1, 2, 3] & contains 2 .~ False
              ==> bag [1, 3]
  
      describe "computations" $
        describe "digits" $ do
          it "preview" $
            31415926 ^? digits.ix 2
              ==> Just 4
  
          it "set" $
            31415926 & digits.ix 2 .~ 8
              ==> 31815926
  
          it "set-flexible" $
            31415926 & digits.ix 2 .~ 99
              ==> 319915926
  
      describe "similar" $ do
        it "like-fmap" $
          [1,2,3,4] & mapped +~ 1
            ==> [2,3,4,5]
  
        it "still-like-fmap" $
          ([1,2,3,4], 10) & mapped +~ 1
            ==> ([1,2,3,4], 11)
  
        it "not-like-fmap" $
          ([1,2,3,4], 10) & _1.mapped +~ 1
            ==> ([2,3,4,5], 10)
  
        it "folded" $
          [1,2,3,4] ^. folded.to Sum
            ==> Sum 10
  
        it "minimumOf" $
          minimumOf (each.field2)
            (Record 1 2,Record 3 4,Record 5 6)
            ==> Just 2
  
        it "sumOf" $
          sumOf (each.field2)
            (Record 1 2,Record 3 4,Record 5 6)
            ==> 12
  
        it "sequenceAOf" $
          sequenceAOf _2 (1,"foo",2)
            ==> [(1,'f',2),(1,'o',2),(1,'o',2)]
  
    describe "Map" $ do
      describe "at" $ do
        describe "view" $ do
          it "present" $
            alist [(1,"x"), (2,"y")] ^. at 1
              ==> Just "x"
  
          it "absent" $
            alist [(1,"x"), (2,"y")] ^. at 3
              ==> Nothing
  
        describe "non" $ do
          it "present" $
            alist [(1,"x"), (2,"y")]
              ^. at 2.non "z"
              ==> "y"
  
          it "absent" $
            alist [(1,"x"), (2,"y")]
              ^. at 3.non "z"
              ==> "z"
  
        describe "set" $ do
          it "positive" $
            alist [(1,"x"), (2,"y")]
              & at 1 .~ Just "z"
              ==> alist [(1,"z"), (2,"y")]
  
          it "negative" $
            alist [(1,"x"), (2,"y")]
              & at 1 .~ Nothing
              ==> alist [(2,"y")]
  
          it "sans" $
            alist [(1,"x"), (2,"y")] & sans 1
              ==> alist [(2,"y")]
  
      describe "ix" $ do
        describe "view" $ do
          it "present" $
            alist [(1,"x"), (2,"y")] ^? ix 1
              ==> Just "x"
  
          it "demand" $
            alist [(1,"x"), (2,"y")] ^?! ix 1
              ==> "x"
  
          it "absent" $
            alist [(1,"x"), (2,"y")] ^? ix 3
              ==> Nothing
  
          it "failing" $
            alist [(1,"x"), (2,"y")]
              ^? failing (ix 3) (ix 1)
              ==> Just "x"
  
          it "like" $
            alist [(1,"x"), (2,"y")]
              ^?! failing (ix 3) (like "z")
              ==> "z"
  
        describe "set" $ do
          it "present" $
            alist [(1,"x"), (2,"y")] & ix 1 .~ "z"
              ==> alist [(1,"z"), (2,"y")]
  
          it "absent" $
            alist [(1,"x"), (2,"y")] & ix 3 .~ "z"
              ==> alist [(1,"x"), (2,"y")]
  
      describe "traverse" $ do
        it "toListOf" $
          alist [(1,"x"), (2,"y")] ^.. traverse
            ==> ["x","y"]
  
        it "withIndex" $
          alist [(1,"x"), (2,"y")]
            ^.. traversed.withIndex
            ==> [(0,"x"),(1,"y")]
  
      describe "itraversed" $
        describe "indices" $ do
          it "toListOf" $
            alist [(1,"x"), (2,"y"), (4,"z")]
              ^.. itraversed.indices even
              ==> ["y", "z"]
  
          it "withIndex" $
            alist [(1,"x"), (2,"y")]
              ^.. itraversed.withIndex
              ==> [(1,"x"),(2,"y")]
  
          it "indices" $
            alist [(1,"x"), (2,"y"), (4,"z")]
              & itraversed.indices even .~ "w"
              ==> alist [(1,"x"),(2,"w"),(4,"w")]
  
    describe "State" $ do
      it "use" $
        use _1 `evalState` (10, 20)
          ==> 10
  
      it "uses" $
        uses _1 negate `evalState` (10, 20)
          ==> -10
  
      it "preuse" $
        preuse (ix 1) `evalState` [1, 2, 3, 4]
          ==> Just 2
  
      it "preuses" $
        preuses (ix 1) negate
          `evalState` [1, 2, 3, 4]
          ==> Just (-2)
  
      it "set" $
        (ix 1 .= 5) `execState` [1, 2, 3, 4]
          ==> [1, 5, 3, 4]
  
      it "over" $
        (ix 1 %= negate)
          `execState` [1, 2, 3, 4]
          ==> [1, -2, 3, 4]
  
      it "setM" $
        (ix 1 <~ pure 5) `execState` [1, 2, 3, 4]
          ==> [1, 5, 3, 4]
  
      it "zoom" $
        zoom _1 (_2 .= 4) `execState` ((1, 2), 3)
          ==> ((1, 4), 3)
  
      it "multi-set-plain" $
        ((1,2,3) & _1 .~ 10
                 & _2 .~ 20
                 & _3 .~ 30)
          ==> (10,20,30)
  
      it "multi-set" $
        ((1,2,3) &~ do _1 .= 10
                       _2 .= 20
                       _3 .= 30)
          ==> (10,20,30)
  
    describe "Advanced" $ do
      describe "partsOf" $ do
        it "indices" $
          [2,4,1,5,3,6]
            & partsOf (traversed.indices odd)
            %~ reverse
            ==> [2,6,1,5,3,4]
  
        it "filtered" $
          [2,4,1,5,3,6]
            & partsOf (traverse.filtered (< 4))
            %~ reverse.sort
            ==> [3,4,2,5,1,6]
  
        it "each" $
          (3,1,2,4,5) & partsOf each %~ sort
            ==> (1,2,3,4,5)
  
        it "set" $
          "Hello, World"
            & partsOf (traverse.filtered isAlpha)
            .~ "Howdy!!!"
            ==> "Howdy, !!!ld"
  
        it "multiple" $
          "00:00:00"
            & partsOf (itraversed.
                       indices (>= 3).
                       filtered (== '0'))
            .~ "1234"
            ==> "00:12:34"
  
      describe "view-patterns" $
        it "lambda" $
          (\(view _2 -> Left x) -> x) (10, Left 20)
            ==> 20
  
      describe "biplate" $ do
        it "strings" $
          ((("foo", "bar"), "!", 2 :: Int, ())
             ^.. biplate :: [String])
            ==> ["foo","bar","!"]
  
        it "ints" $
          ((("foo", "bar"), "!", 2 :: Int, ())
             ^.. biplate :: [Int])
            ==> [2]
  
        it "chars" $
          ((("foo", "bar"), "!", 2 :: Int, ())
             & biplate %~ toUpper)
            ==> (("FOO","BAR"),"!",2,())
  
        it "head" $
          ((("foo","bar"),"!", 2 :: Int, ())
             & (biplate
                  :: Data s
                  => Traversal' s String)._head
             %~ toUpper)
            ==> (("Foo","Bar"),"!",2,())
  
        it "partsOf" $
          (("foo","bar"),"!", 2 :: Int, ())
            & partsOf biplate
            %~ (reverse :: String -> String)
            ==> (("!ra","boo"),"f",2,())
  
        it "filtered" $
          (("foo","bar"),"!", 2 :: Int, ())
            & partsOf (biplate.filtered (<= 'm'))
            %~ (reverse :: String -> String)
            ==> (("!oo","abr"),"f",2,())
  
  -- Local Variables:
  -- haskell-indent-spaces: 2
  -- haskell-indentation-ifte-offset: 2
  -- haskell-indentation-layout-offset: 2
  -- haskell-indentation-left-offset: 2
  -- haskell-indentation-starter-offset: 2
  -- haskell-indentation-where-post-offset: 2
  -- haskell-indentation-where-pre-offset: 2
  -- End:
  