<commit_before>{-# LANGUAGE FlexibleContexts           #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE RankNTypes                 #-}
{-# LANGUAGE TemplateHaskell            #-}

module Lens where

import Control.Applicative (Alternative, Applicative, (<$>), (<*>))
import Control.Lens
import Control.Monad.State

type Degrees = Double
type Latitude = Degrees
type Longitude = Degrees

data Meetup =
  Meetup { _name :: String, _location :: (Latitude, Longitude) }
  deriving (Show, Eq)
makeLenses ''Meetup

{-|
with State monad
>>> testState
(True,Meetup {_name = "foo", _location = (2.0,4.0)})
-}

testState :: (Bool, Meetup)
testState = runState `flip` Meetup "foo" (2, 3) $ do
  location . _2 %= (+1)
  lo <- use (location . _2)
  return $ lo > 1

{-|
>>> [(1,"one"),(2,"two")] ^.. traverse . _2
["one","two"]
-}

testRef :: Lens' Meetup Degrees -> Meetup -> Bool
testRef l s = s ^. l > 2

{-|
>>> runIdentity $ mapMOf traverse (\i -> Identity $ take i $ repeat '*') [1,2,3] :: [String]
["*","**","***"]
-}


--
-- DSL with Lens/Prism
--

newtype DSL a =
  DSL { unDSL :: StateT DSLState [] a }
  deriving (Functor, Applicative, Monad, Alternative, MonadPlus,
            MonadState DSLState)

data DSLState =
  DSLState
  { _exprs :: [DSL Bool]
  , _vars  :: Vars
  }

type Vars = (Int, Int, Int)
type Var = Lens' Vars Int

makeLenses ''DSLState

runDSL :: DSL a -> [a]
runDSL dsl = evalStateT `flip` (DSLState [] (0, 0, 0)) $ unDSL $ dsl

infixr 0 $=
($=) :: MonadState DSLState m => Var -> Int -> m ()
l $= i = vars . l .= i

infixl 7 $*
($*) :: (Applicative m, MonadState DSLState m) => Var -> Var -> m Int
x $* y = (*) <$> (use (vars . x)) <*> (use (vars . y))

addExpr :: MonadState DSLState m => DSL Bool -> m ()
addExpr e = exprs %= (e:)

addPred :: MonadState DSLState m => (Int -> Int -> Bool) -> Var -> Var -> m ()
addPred p lx ly = addExpr $ do
  x <- use (vars . lx)
  y <- use (vars . ly)
  return $ p x y

{-|
>>> runDSL dsl1
[(2,3,5)]
-}
dsl1 :: MonadState DSLState m => m Vars
dsl1 = do
  _1 $= 2
  _2 $= 3
  _3 $= 5
  use vars

{-|
>>> runDSL dsl2
[6]
-}
dsl2 :: (Applicative m, MonadState DSLState m) => m Int
dsl2 = do
  _1 $= 2
  _2 $= 3
  _3 $= 5
  n <- _1 $* _2
  return n

-- an user defined predicate
pred1 :: Int -> Int -> Bool
pred1 x y = abs (x - y) < 2

{-|
>>> runDSL dsl3
[False]
-}
eval :: DSL Bool
eval = do
  es <- use exprs
  liftM and $ sequence es

dsl3 :: DSL Bool
dsl3 = do
  _1 $= 2
  _2 $= 3
  _3 $= 5
  addPred pred1 _1 _2
  addPred pred1 _2 _3
  -- addExpr $ (*) <$> use _1 <*> use _2
  eval

msAction :: Monad m => m Int
msAction = return 1

msAction2 :: MonadState DSLState m => m Int
msAction2 = use (vars . _1)

dsl4 :: MonadState DSLState m => m Int
dsl4 = do
  msAction
  msAction2<commit_msg>Modified to use more type classes.<commit_after>{-# LANGUAGE ConstraintKinds            #-}
{-# LANGUAGE FlexibleContexts           #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE RankNTypes                 #-}
{-# LANGUAGE TemplateHaskell            #-}

module Lens where

import Control.Applicative (Alternative, Applicative, (<$>), (<*>))
import Control.Lens
import Control.Monad.State

type Degrees = Double
type Latitude = Degrees
type Longitude = Degrees

data Meetup =
  Meetup { _name :: String, _location :: (Latitude, Longitude) }
  deriving (Show, Eq)
makeLenses ''Meetup

{-|
with State monad
>>> testState
(True,Meetup {_name = "foo", _location = (2.0,4.0)})
-}

testState :: (Bool, Meetup)
testState = runState `flip` Meetup "foo" (2, 3) $ do
  location . _2 %= (+1)
  lo <- use (location . _2)
  return $ lo > 1

{-|
>>> [(1,"one"),(2,"two")] ^.. traverse . _2
["one","two"]
-}

testRef :: Lens' Meetup Degrees -> Meetup -> Bool
testRef l s = s ^. l > 2

{-|
>>> runIdentity $ mapMOf traverse (\i -> Identity $ take i $ repeat '*') [1,2,3] :: [String]
["*","**","***"]
-}


--
-- DSL with Lens/Prism
--

newtype DSL a =
  DSL { unDSL :: StateT (DSLState DSL) [] a }
  deriving (Functor, Applicative, Monad, Alternative, MonadPlus,
            MonadState (DSLState DSL))

data DSLState m =
  DSLState
  { _exprs :: [m Bool]
  , _vars  :: Vars
  }

type MonadDSL m = (Applicative m, MonadState (DSLState m) m)

type Vars = (Int, Int, Int)
type Var = Lens' Vars Int

makeLenses ''DSLState

runDSL :: DSL a -> [a]
runDSL dsl = evalStateT `flip` (DSLState [] (0, 0, 0)) $ unDSL $ dsl

infixr 0 $=
($=) :: MonadDSL m => Var -> Int -> m ()
l $= i = vars . l .= i

infixl 7 $*
($*) :: MonadDSL m => Var -> Var -> m Int
x $* y = (*) <$> (use (vars . x)) <*> (use (vars . y))

addExpr :: MonadDSL m => m Bool -> m ()
addExpr e = exprs %= (e:)

addPred :: MonadDSL m => (Int -> Int -> Bool) -> Var -> Var -> m ()
addPred p lx ly = addExpr $ do
  x <- use (vars . lx)
  y <- use (vars . ly)
  return $ p x y

{-|
>>> runDSL dsl1
[(2,3,5)]
-}
dsl1 :: MonadDSL m => m Vars
dsl1 = do
  _1 $= 2
  _2 $= 3
  _3 $= 5
  use vars

{-|
>>> runDSL dsl2
[6]
-}
dsl2 :: MonadDSL m => m Int
dsl2 = do
  _1 $= 2
  _2 $= 3
  _3 $= 5
  n <- _1 $* _2
  return n

-- an user defined predicate
pred1 :: Int -> Int -> Bool
pred1 x y = abs (x - y) < 2

{-|
>>> runDSL dsl3
[False]
-}
eval :: MonadDSL m => m Bool
eval = do
  es <- use exprs
  liftM and $ sequence es

dsl3 :: MonadDSL m => m Bool
dsl3 = do
  _1 $= 2
  _2 $= 3
  _3 $= 5
  addPred pred1 _1 _2
  addPred pred1 _2 _3
  -- addExpr $ (*) <$> use _1 <*> use _2
  eval

msAction :: Monad m => m Int
msAction = return 1

msAction2 :: MonadDSL m => m Int
msAction2 = use (vars . _1)

dsl4 :: MonadDSL m => m Int
dsl4 = do
  msAction
  msAction2
{'fraction_non_alphanumeric': 0.17797372683102394, 'fraction_numerical': 0.026273168976066224, 'mean_word_length': 2.680794701986755, 'pattern_counts': {'":': 0, '<': 27, '<?xml version=': 0, '>': 107, 'https://': 0, 'lorem ipsum': 0, 'www.': 0, 'xml': 0}, 'pii_count': 0, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 0, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '5746148', 'n_tokens_mistral': 2409, 'n_tokens_neox': 2287, 'n_words': 706}