Jalali.elm

import Html exposing (text)
islamic_epoch = 1948439.5
gregorian_epoch = 1721425.5
persian_epoch = 1948320.5


type alias Date =
  { year : Int
  , month : Int
  , day : Int
  }

mod : Float -> Float -> Float
mod a b = 
  a - (b * toFloat(floor(a / b)))

leap_islamic : Int -> Bool
leap_islamic year = ((year * 11) + 14) % 30 < 11

leap_gregorian : Int -> Bool
leap_gregorian year = 
  (year % 4 == 0) && not( (year % 100 == 0) && (year % 400 /= 0) )

leap_persian : Int -> Bool
leap_persian year =
  (((((year - (if year > 0 then 474 else 473))
  % 2820 )
  + 512 )
  * 682 )
  % 2816 )
  < 682

gregorian_to_jd: Date -> Float
gregorian_to_jd date =
  (gregorian_epoch - 1)
  + (365 * (toFloat(date.year) - 1))
  + toFloat(floor(toFloat(date.year - 1) / 4))
  + toFloat(-1 * floor(toFloat(date.year - 1) / 100))
  + toFloat(floor(toFloat(date.year - 1) / 400))
  + toFloat(floor(((367 * toFloat(date.month)) - 362) / 12))
  + (if date.month <= 2 then 0 else 
      (if leap_gregorian(date.year) then -1 else -2)
    )
  + toFloat(date.day)

islamic_to_jd: Int -> Int -> Int -> Float
islamic_to_jd year month day =
  toFloat(day)
  + toFloat(ceiling(29.5 * toFloat(month - 1)))
  + toFloat((year - 1) * 354)
  + toFloat(floor(toFloat(3 + (11 * year)) / 30))
  + islamic_epoch - 1.0

persian_to_jd: Date -> Float
persian_to_jd date =
  let
    epbase = toFloat(date.year - if date.year >=0 then 474 else 473)
    epyear = 474 + mod epbase 2820
  in
    toFloat(date.day)
    + toFloat(if date.month <=7 then (date.month - 1) * 31 else ((date.month - 1) * 30) + 6)
    + toFloat(floor(((epyear * 682) - 110) / 2816))
    + toFloat(floor(epbase / 2820) * 1029983)
    + ((epyear - 1) * 365)
    + persian_epoch - 1

jd_to_persian: Float -> Date
jd_to_persian jd =
  let
    jdf = toFloat(floor(jd)) + 0.5
    depoch = jdf - 2121445.5
    cycle = floor(depoch / 1029983)
    cyear = mod depoch 1029983
    aux1 = floor(cyear / 366)
    aux2 = mod cyear 366
    ycycle = if cyear == 1029982 then 2820 else 
      (floor(((aux2 * 2816) + toFloat(aux1 * 2134)  + 2815) / 1028522) + aux1 + 1)
    year = if (ycycle + (2820 * cycle) + 474) <= 0 then 
        (ycycle + (2820 * cycle) + 473)
      else
        (ycycle + (2820 * cycle) + 474)
    yday = (jd - (persian_to_jd (Date year 1 1))) + 1
    month = if yday <= 186 then ceiling(yday / 31) else ceiling((yday - 6) / 30)
    day = round(jd - (persian_to_jd (Date year month 1)) + 1)
  in
    Date year month day

jd_to_gregorian: Float -> Date
jd_to_gregorian jd =
  let
    wjd = toFloat(floor(jd - 0.5)) + 0.5
    depoch = wjd - gregorian_epoch
    quadricent = floor(depoch / 146097)
    dqc = mod depoch 146097
    cent = floor(dqc / 36524)
    dcent = mod dqc 36524
    quad = floor(dcent / 1461)
    dquad = mod dcent 1461
    yindex = floor(dquad / 365)
    initialyear = (quadricent * 400) + (cent * 100) + (quad * 4) + yindex
    year = if cent == 4 || yindex == 4 then initialyear else initialyear + 1
    yearday = wjd - gregorian_to_jd (Date year 1 1)
    leapadj = if wjd < gregorian_to_jd (Date year 3 1) then 0 else
      (if leap_gregorian year then 1 else 2)
    month = floor((((yearday + leapadj) * 12) + 373) / 367)
    day = round(wjd - (gregorian_to_jd (Date year month 1)) + 1)
  in
    Date year month day


-----------------------------------------------------
-- Usage
-----------------------------------------------------
today = Date 1367 09 28
main = 
  persian_to_jd today
    |> jd_to_gregorian
    |> toString
    |> text