content: {-# LANGUAGE FlexibleContexts #-}
  module Iterator where
  import           Singleton                (Exp (..))
  import           Visitor
  
  import           Control.Applicative
  import           Control.Monad.State.Lazy
  import           Data.Coerce              (coerce)
  import           Data.Functor.Compose
  import           Data.Functor.Const
  import           Data.Functor.Identity
  import           Data.Functor.Product
  import           Data.Monoid              (Sum (..), getSum)
  
  instance Functor Exp where
      fmap f (Var x)   = Var x
      fmap f (Val a)   = Val $ f a
      fmap f (Add x y) = Add (fmap f x) (fmap f y)
      fmap f (Mul x y) = Mul (fmap f x) (fmap f y)
  
  instance Traversable Exp where
      traverse g (Var x)   = pure $ Var x
      traverse g (Val x)   = Val <$> g x
      traverse g (Add x y) = Add <$> traverse g x <*> traverse g y
      traverse g (Mul x y) = Mul <$> traverse g x <*> traverse g y
  
  -- getConst . traverse (Const . f) = foldMap f
  
  -- Functor Product
  (<#>) :: (Functor m, Functor n) => (a -> m b) -> (a -> n b) -> (a -> Product m n b)
  (f <#> g) y = Pair (f y) (g y)
  
  -- Functor composition
  (<.>) :: (Functor m, Functor n) => (b -> n c) -> (a -> m b) -> (a -> (Compose m n) c)
  f <.> g = Compose . fmap f . g
  
  cciBody :: Char -> Sum Integer
  cciBody _ = 1
  
  cci :: String -> (Const (Sum Integer)) [a]
  cci = traverse (Const . cciBody)
  
  lciBody :: Char -> Sum Integer
  lciBody c = if (c == '\n') then 1 else 0
  
  lci :: String -> (Const (Sum Integer)) [a]
  lci = traverse (Const . lciBody)
  
  clci :: String -> Product (Const (Sum Integer)) (Const (Sum Integer)) [a]
  clci = traverse ((Const . cciBody) <#> (Const . lciBody))
  
  -- wciBody and wci based on suggestion by NoughtMare
  wciBody :: Char -> Maybe SepCount
  wciBody = Just . mkSepCount isSpace where
      isSpace :: Char -> Bool
      isSpace c = c == ' ' || c == '\n' || c == '\t'
  
  -- using traverse to count words in a String
  wci :: String -> Const (Maybe SepCount) [Integer]
  wci = traverse (Const . wciBody) 
  
  -- Forming the Product of character counting, line counting and word counting
  -- and performing a one go traversal using this Functor product
  clwci :: String -> (Product (Product (Const (Sum Integer)) (Const (Sum Integer))) (Const (Maybe SepCount))) [Integer]
  clwci = traverse ((Const . cciBody) <#> (Const . lciBody) <#> (Const . wciBody))  
  
  -- or much simpler, just use a foldMap 
  clwci'' :: Foldable t => t Char -> (Sum Integer, Sum Integer, Maybe SepCount)
  clwci'' = foldMap (\x -> (cciBody x, lciBody x, wciBody x))
  
  
  -- original solution from 'The Essence of the Iterator Patern' paper
  wciBody' :: Char -> Compose (WrappedMonad (State Bool)) (Const (Sum Integer)) a
  wciBody' c =  coerce (updateState c) where
      updateState :: Char -> Bool -> (Sum Integer, Bool)
      updateState c w = let s = not(isSpace c) in (test (not w && s), s)
      isSpace :: Char -> Bool
      isSpace c = c == ' ' || c == '\n' || c == '\t'
      test :: Bool -> Sum Integer
      test b = Sum $ if b then 1 else 0
  
  wci' :: String -> Compose (WrappedMonad (State Bool)) (Const (Sum Integer)) [a]
  wci' = traverse wciBody'
  
  clwci' :: String -> (Product (Product (Const (Sum Integer)) (Const (Sum Integer))) (Compose (WrappedMonad (State Bool)) (Const (Sum Integer)))) [a]
  clwci' = traverse ((Const . cciBody) <#> (Const . lciBody) <#> wciBody')
  
  data SepCount = SC Bool Bool Integer
    deriving Show
  
  mkSepCount :: (a -> Bool) -> a -> SepCount
  mkSepCount pred x = SC p p (if p then 0 else 1)
    where
      p = pred x
  
  getSepCount :: SepCount -> Integer
  getSepCount (SC _ _ n) = n    
  
  instance Semigroup SepCount where
    (SC l0 r0 n) <> (SC l1 r1 m) = SC l0 r1 x where
      x | not r0 && not l1 = n + m - 1
        | otherwise = n + m
  
  extractCount :: Const (Maybe SepCount) a -> Integer
  extractCount (Const (Just sepCount)) =  getSepCount sepCount   
  
  -- | the actual wordcount implementation.
  --   for any String a triple of linecount, wordcount, charactercount is returned
  wc :: String -> (Integer, Integer, Integer)
  wc str =
      let raw = clwci str
          cc  = coerce $ pfst (pfst raw)
          lc  = coerce $ psnd (pfst raw)
          wc  = extractCount (psnd raw)
      in (lc,wc,cc)
  
  wc'' :: String -> (Integer, Integer, Integer)
  wc'' str =
      let (rawCC, rawLC, rawWC) = clwci'' str
          cc  = coerce rawCC
          lc  = coerce rawLC
          wc  = extractCount $ Const rawWC
      in (lc,wc,cc)    
  
  str :: String
  str = "hello \n world"
  
  pfst :: Product f g a -> f a
  pfst (Pair fst _) = fst
  psnd :: Product f g a -> g a
  psnd (Pair _ snd) = snd
  
  iteratorDemo = do
      putStrLn "Iterator -> Traversable"
      let exp = Mul (Add (Val 3) (Val 1))
                  (Mul (Val 2) (Var "pi"))
          env = [("pi", pi)]
      print $ traverse (\x c -> if even x then [x] else [2*x]) exp 0
  
      print $ wc "hello \n world"
  
  
  