Repetition.hs

{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE OverloadedStrings          #-}
{-# LANGUAGE TupleSections              #-}

module System.TaskPipeline.Repetition
  ( RepInfo(..)
  , TRIndex(..)
  , HasTRIndex(..)
  , OneOrSeveral(..)
  , parMapTask
  , parMapTask_
  , IndexRange(..)
  , oneIndex
  , oneRange
  , enumIndices
  , enumTRIndices
  ) where

import           Control.Applicative
import           Control.Arrow.Free                       (mapA)
import           Control.Lens                             hiding ((.=))
import           Control.Monad
import           Data.Aeson
import           Data.Aeson.Types                         (Parser)
import qualified Data.Text                                as T
import           Prelude                                  hiding ((.))
import           System.TaskPipeline.PTask
import           System.TaskPipeline.Repetition.Internal


-- | Makes a 'PTask' repeatable and maps it in parallel over a list.
parMapTask
  :: (HasTRIndex a, KatipContext m)
  => RepInfo
  -> PTask m a b
  -> PTask m [a] [b]
parMapTask ri =
  over taskRunnablePart mapA . makeTaskRepeatable ri

-- | Simply repeats a task which takes no input over a list of indices, and
-- ignores the end result. See 'RepInfo' for how these indices are
-- used. See 'parMapTask' for a more complete version.
parMapTask_
  :: (HasTRIndex idx, KatipContext m)
  => RepInfo
  -> PTask m () b
  -> PTask m [idx] ()
parMapTask_ ri task =
   arr (map (, ())) >>> parMapTask ri (arr snd >>> task) >>> arr (const ())


-- * A simple type to handle index ranges

data OneRange i = OneIndex i | OneRange i i

toJSONStr :: (ToJSON a) => a -> Either Value T.Text
toJSONStr a = case toJSON a of
  String s -> Right s
  Number n -> Right $ T.pack $ show n
  o        -> Left o

parseJSONStr :: (FromJSON a) => T.Text -> Parser a
parseJSONStr v = tryNumber v <|> parseJSON (String v)
  where
    tryNumber n = case reads $ T.unpack n of
      [(n',_)] -> parseJSON $ Number n'
      _        -> fail "Not a number"

instance (ToJSON i) => ToJSON (OneRange i) where
  toJSON (OneIndex i) = toJSON i
  toJSON (OneRange a b) = case (toJSONStr a, toJSONStr b) of
    (Right a', Right b') -> String $ a' <> ".." <> b'
    (a', b')             -> object ["lower" .= toJ a', "upper" .= toJ b']
    where toJ (Left o)  = o
          toJ (Right s) = String s

instance (FromJSON i) => FromJSON (OneRange i) where
  parseJSON o@(String s) = case T.splitOn ".." s of
    [a,b] -> (OneRange <$> parseJSONStr a <*> parseJSONStr b)
             <|> (OneIndex <$> parseJSON o)
    _ -> OneIndex <$> parseJSON o
  parseJSON (Object o) = OneRange <$> o .: "lower" <*> o .: "upper"
  parseJSON o = OneIndex <$> parseJSON o

-- | Allows to read from a JSON file either one @a@ or an array of @a@
newtype OneOrSeveral a = OneOrSeveral {getOneOrSeveral :: [a]}

instance (ToJSON a) => ToJSON (OneOrSeveral a) where
  toJSON (OneOrSeveral [r]) = toJSON r
  toJSON (OneOrSeveral rs)  = toJSON rs

instance (FromJSON a) => FromJSON (OneOrSeveral a) where
  parseJSON o@(Array _) = OneOrSeveral <$> parseJSON o
  parseJSON o           = OneOrSeveral . (:[]) <$> parseJSON o

-- | A simple index list that can be used in configuration, and from which a
-- list of indices can be extracted. The JSON representation of it is more
-- compact than that of [(i,i)], as ranges are represented by "a..b" strings
newtype IndexRange i = IndexRange (OneOrSeveral (OneRange i))
  deriving (FromJSON, ToJSON)

-- | A range of just one index
oneIndex :: i -> IndexRange i
oneIndex i = IndexRange $ OneOrSeveral [OneIndex i]

-- | A range of consecutive values
oneRange :: i -> i -> IndexRange i
oneRange a b = IndexRange $ OneOrSeveral [OneRange a b]

-- | Gives a list of indices from an index range
enumIndices :: (Enum i) => IndexRange i -> [i]
enumIndices (IndexRange (OneOrSeveral rs)) = concatMap toL rs
  where
    toL (OneIndex i)   = [i]
    toL (OneRange a b) = [a..b]

-- | Gives a list of TaskRepetitionIndex 
enumTRIndices :: (Enum i, Show i) => IndexRange i -> [TRIndex]
enumTRIndices = map (TRIndex . show) . enumIndices